1
% /****************************************************************************\
2
% Part of the XeTeX typesetting system
3
% copyright (c) 1994-2006 by SIL International
4
% written by Jonathan Kew
6
% Permission is hereby granted, free of charge, to any person obtaining
7
% a copy of this software and associated documentation files (the
8
% "Software"), to deal in the Software without restriction, including
9
% without limitation the rights to use, copy, modify, merge, publish,
10
% distribute, sublicense, and/or sell copies of the Software, and to
11
% permit persons to whom the Software is furnished to do so, subject to
12
% the following conditions:
14
% The above copyright notice and this permission notice shall be
15
% included in all copies or substantial portions of the Software.
17
% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
18
% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
19
% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
20
% NONINFRINGEMENT. IN NO EVENT SHALL SIL INTERNATIONAL BE LIABLE FOR
21
% ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
22
% CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
23
% WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
25
% Except as contained in this notice, the name of SIL International
26
% shall not be used in advertising or otherwise to promote the sale,
27
% use or other dealings in this Software without prior written
28
% authorization from SIL International.
29
% \****************************************************************************/
34
% Procedure to build xetex from web sources:
36
% (1) build etex-web2c.web:
37
% ./tie -m etex.web ../../../../TeX/texk/web2c/tex.web ../../../../TeX/texk/web2c/etexdir/etex.ch ../../../../TeX/texk/web2c/etexdir/etex.fix
39
% (2) add xetex features, and remove enctex ones
40
% ./tie -m xetex.web etex.web xetex-new.ch xetex-noenc.ch
42
% (4) use otangle, web2c, etc....
53
@d eTeX_version_string=='-2.2' {current \eTeX\ version}
55
@d eTeX_version_string=='-2.2' {current \eTeX\ version}
58
@d XeTeX_revision==".996"
59
@d XeTeX_version_string=='-0.996' {current \XeTeX\ version}
63
@d eTeX_banner_k=='This is e-TeXk, Version 3.141592',eTeX_version_string
64
@d eTeX_banner=='This is e-TeX, Version 3.141592',eTeX_version_string
65
{printed when \eTeX\ starts}
67
@d TeX_banner_k=='This is TeXk, Version 3.141592' {printed when \TeX\ starts}
68
@d TeX_banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
70
@d banner==eTeX_banner
71
@d banner_k==eTeX_banner_k
73
@d XeTeX_banner=='This is XeTeX, Version 3.141592',eTeX_version_string,XeTeX_version_string
74
{printed when \XeTeX\ starts}
75
@d XeTeX_banner_k=='This is XeTeXk, Version 3.141592',eTeX_version_string,XeTeX_version_string
77
@d banner==XeTeX_banner
78
@d banner_k==XeTeX_banner_k
82
@d TEX==ETEX {change program name into |ETEX|}
84
@d TEX==XETEX {change program name into |XETEX|}
88
@d TeXXeT_code=0 {the \TeXXeT\ feature is optional}
90
@d eTeX_states=1 {number of \eTeX\ state variables in |eqtb|}
92
@d TeXXeT_code=0 {the \TeXXeT\ feature is optional}
94
@d XeTeX_dash_break_code = 1 {non-zero to enable breaks after en- and em-dashes}
96
@d XeTeX_default_input_mode_code = 2 {input mode for newly opened files}
97
@d XeTeX_input_mode_auto = 0
98
@d XeTeX_input_mode_utf8 = 1
99
@d XeTeX_input_mode_utf16be = 2
100
@d XeTeX_input_mode_utf16le = 3
101
@d XeTeX_input_mode_raw = 4
102
@d XeTeX_input_mode_icu_mapping = 5
104
@d XeTeX_default_input_encoding_code = 3 {str_number of encoding name if mode = ICU}
106
@d eTeX_states=4 {number of \eTeX\ state variables in |eqtb|}
110
@d hyph_prime=607 {another prime for hashing \.{\\hyphenation} exceptions;
111
if you change this, you should also change |iinf_hyphen_size|.}
113
@d hyph_prime=607 {another prime for hashing \.{\\hyphenation} exceptions;
114
if you change this, you should also change |iinf_hyphen_size|.}
116
@d biggest_char=65535 {the largest allowed character number;
117
must be |<=max_quarterword|}
118
@d too_big_char=65536 {|biggest_char+1|}
119
@d special_char=65537 {|biggest_char+2|}
120
@d number_chars=65536 {|biggest_char+1|}
121
@d biggest_reg=255 {the largest allowed register number;
122
must be |<=max_quarterword|}
123
@d number_regs=256 {|biggest_reg+1|}
124
@d font_biggest=255 {the real biggest font}
125
@d number_fonts=font_biggest-font_base+2
126
@d number_math_families=256
127
@d number_math_fonts=number_math_families+number_math_families+number_math_families
128
@d math_font_biggest=number_math_fonts-1
129
@d text_size=0 {size code for the largest size in a family}
130
@d script_size=number_math_families {size code for the medium size in a family}
131
@d script_script_size=number_math_families+number_math_families {size code for the smallest size in a family}
137
@* \[2] The character set.
139
@* \[2] The character set.
143
@ Characters of text that have been converted to \TeX's internal form
144
are said to be of type |ASCII_code|, which is a subrange of the integers.
147
@!ASCII_code=0..255; {eight-bit numbers}
149
@ Characters of text that have been converted to \TeX's internal form
150
are said to be of type |ASCII_code|, which is a subrange of the integers.
151
For xetex, we rename |ASCII_code| as |UTF16_code|. But we also have a
152
new type |UTF8_code|, used when we construct filenames to pass to the
155
@d ASCII_code==UTF16_code
156
@d packed_ASCII_code==packed_UTF16_code
159
@!ASCII_code=0..biggest_char; {16-bit numbers}
160
@!UTF8_code=0..255; {8-bit numbers}
161
@!UnicodeScalar=0..@"10FFFF; {Unicode scalars}
165
@d last_text_char=255 {ordinal number of the largest element of |text_char|}
167
@d last_text_char=biggest_char {ordinal number of the largest element of |text_char|}
171
@* \[3] Input and output.
173
@* \[3] Input and output.
177
@!name_of_file:^text_char;
178
@!name_length:0..file_name_size;@/{this many characters are actually
179
relevant in |name_of_file| (the rest are blank)}
181
@!name_of_file:^UTF8_code; {we build filenames in utf8 to pass to the OS}
182
@!name_of_file16:^UTF16_code; {but sometimes we need a utf16 version of the name}
183
@!name_length:0..file_name_size;@/{this many characters are actually
184
relevant in |name_of_file| (the rest are blank)}
185
@!name_length16:0..file_name_size;
189
@d term_in==stdin {the terminal as an input file}
194
@!bound_default:integer; {temporary for setup}
196
@!term_in:unicode_file;
198
@!bound_default:integer; {temporary for setup}
202
@* \[4] String handling.
204
@* \[4] String handling.
208
|str_start[s]<=j<str_start[s+1]|. Additional integer variables
210
|str_start_macro[s]<=j<str_start_macro[s+1]|. Additional integer variables
214
|str_pool[pool_ptr]| and |str_start[str_ptr]| are
216
|str_pool[pool_ptr]| and |str_start_macro[str_ptr]| are
220
@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|}
221
@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|}
223
@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|}
224
@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|}
225
@d str_start_macro(#) == str_start[(#) - too_big_char]
229
@!packed_ASCII_code = 0..255; {elements of |str_pool| array}
231
@!packed_ASCII_code = 0..65535; {elements of |str_pool| array}
235
@d length(#)==(str_start[#+1]-str_start[#]) {the number of characters
238
@p function length(s:str_number):integer;
239
{the number of characters in string number |s|}
240
begin if (s>=@"10000) then length:=str_start_macro(s+1)-str_start_macro(s)
241
else if (s>=@"20) and (s<@"7F) then length:=1
242
else if (s<=@"7F) then length:=3
243
else if (s<@"100) then length:=4
249
@d cur_length == (pool_ptr - str_start[str_ptr])
251
@d cur_length == (pool_ptr - str_start_macro(str_ptr))
255
incr(str_ptr); str_start[str_ptr]:=pool_ptr;
257
incr(str_ptr); str_start_macro(str_ptr):=pool_ptr;
261
@d flush_string==begin decr(str_ptr); pool_ptr:=str_start[str_ptr];
263
@d flush_string==begin decr(str_ptr); pool_ptr:=str_start_macro(str_ptr);
267
begin j:=str_start[s];
268
while j<str_start[s+1] do
270
begin j:=str_start_macro(s);
271
while j<str_start_macro(s+1) do
275
j:=str_start[s]; k:=str_start[t];
276
while j<str_start[s+1] do
277
begin if str_pool[j]<>str_pool[k] then goto not_found;
280
if (length(s)=1) then begin
281
if s<65536 then begin
282
if t<65536 then begin
283
if s<>t then goto not_found;
286
if s<>str_pool[str_start_macro(t)] then goto not_found;
290
if t<65536 then begin
291
if str_pool[str_start_macro(s)]<>t then goto not_found;
294
if str_pool[str_start_macro(s)]<>str_pool[str_start_macro(t)] then
300
j:=str_start_macro(s); k:=str_start_macro(t);
301
while j<str_start_macro(s+1) do
302
begin if str_pool[j]<>str_pool[k] then goto not_found;
308
begin pool_ptr:=0; str_ptr:=0; str_start[0]:=0;
310
begin pool_ptr:=0; str_ptr:=0;
314
@ @d app_lc_hex(#)==l:=#;
315
if l<10 then append_char(l+"0")@+else append_char(l-10+"a")
317
@ The first 65536 strings will consist of a single character only.
318
But we don't actually make them; they're simulated on the fly.
323
begin if (@<Character |k| cannot be printed@>) then
324
begin append_char("^"); append_char("^");
325
if k<@'100 then append_char(k+@'100)
326
else if k<@'200 then append_char(k-@'100)
327
else begin app_lc_hex(k div 16); app_lc_hex(k mod 16);
335
str_ptr:=too_big_char;
336
str_start_macro(str_ptr):=pool_ptr;
341
@<Character |k| cannot be printed@>=
344
@<Character |k| cannot be printed@>=
345
{ this module is not used }
349
name_of_file := xmalloc_array (ASCII_code, name_length + 1);
351
name_of_file := xmalloc_array (UTF8_code, name_length + 1);
355
else begin if (xord[m]<"0")or(xord[m]>"9")or@|
356
(xord[n]<"0")or(xord[n]>"9") then
358
else begin if (m<"0")or(m>"9")or@|
359
(n<"0")or(n>"9") then
363
l:=xord[m]*10+xord[n]-"0"*11; {compute the length}
365
l:=m*10+n-"0"*11; {compute the length}
369
append_char(xord[m]);
375
loop@+ begin if (xord[n]<"0")or(xord[n]>"9") then
377
loop@+ begin if (n<"0")or(n>"9") then
387
@* \[5] On-line and off-line printing.
389
@* \[5] On-line and off-line printing.
393
procedure print_char(@!s:ASCII_code); {prints a single character}
395
begin if @<Character |s| is the current new-line character@> then
396
if selector<pseudo then
397
begin print_ln; return;
400
term_and_log: begin wterm(xchr[s]); wlog(xchr[s]);
401
incr(term_offset); incr(file_offset);
402
if term_offset=max_print_line then
403
begin wterm_cr; term_offset:=0;
405
if file_offset=max_print_line then
406
begin wlog_cr; file_offset:=0;
409
log_only: begin wlog(xchr[s]); incr(file_offset);
410
if file_offset=max_print_line then print_ln;
412
term_only: begin wterm(xchr[s]); incr(term_offset);
413
if term_offset=max_print_line then print_ln;
415
no_print: do_nothing;
416
pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
417
new_string: begin if pool_ptr<pool_size then append_char(s);
418
end; {we drop characters if the string space is full}
419
othercases write(write_file[selector],xchr[s])
424
procedure print_visible_char(@!s:ASCII_code); {prints a single character}
425
label exit; {label is not used but nonetheless kept (for other changes?)}
428
term_and_log: begin wterm(xchr[s]); wlog(xchr[s]);
429
incr(term_offset); incr(file_offset);
430
if term_offset=max_print_line then
431
begin wterm_cr; term_offset:=0;
433
if file_offset=max_print_line then
434
begin wlog_cr; file_offset:=0;
437
log_only: begin wlog(xchr[s]); incr(file_offset);
438
if file_offset=max_print_line then print_ln;
440
term_only: begin wterm(xchr[s]); incr(term_offset);
441
if term_offset=max_print_line then print_ln;
443
no_print: do_nothing;
444
pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
445
new_string: begin if pool_ptr<pool_size then append_char(s);
446
end; {we drop characters if the string space is full}
447
othercases write(write_file[selector],xchr[s])
452
@ The |print_char| procedure sends one character to the desired destination.
453
Control sequence names, file names and string constructed with
454
\.{\\string} might contain |ASCII_code| values that can't
455
be printed using |print_visible_char|. These characters will be printed
456
in three- or four-symbol form like `\.{\^\^A}' or `\.{\^\^e4}',
457
unless the -8bit option is enabled.
458
Output that goes to the terminal and/or log file is treated differently
459
when it comes to determining whether a character is printable.
461
@d print_lc_hex(#)==l:=#;
462
if l<10 then print_visible_char(l+"0")@+else print_visible_char(l-10+"a")
464
@<Basic printing...@>=
465
procedure print_char(@!s:ASCII_code); {prints a single character}
468
begin if (selector>pseudo) and (not doing_special) then {"printing" to a new string, don't encode chars}
469
begin print_visible_char(s); return;
471
if @<Character |s| is the current new-line character@> then
472
if selector<pseudo then
473
begin print_ln; return;
475
if (s < 32) and (eight_bit_p = 0) and (not doing_special) then begin
476
{ control char: ^^X }
477
print_visible_char("^"); print_visible_char("^"); print_visible_char(s+64);
478
end else if s < 127 then
480
print_visible_char(s)
481
else if (s = 127) then begin
483
if (eight_bit_p = 0) and (not doing_special) then begin
484
print_visible_char("^"); print_visible_char("^"); print_visible_char("?")
486
print_visible_char(s)
487
end else if (s < @"A0) and (eight_bit_p = 0) and (not doing_special) then begin { C1 controls: ^^xx }
488
print_visible_char("^"); print_visible_char("^");
489
print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
491
{ char >= 128: encode as UTF8 }
492
if s<@"800 then begin
493
print_visible_char(@"C0 + s div @"40);
494
print_visible_char(@"80 + s mod @"40);
497
print_visible_char(@"E0 + s div @"1000);
498
print_visible_char(@"80 + (s mod @"1000) div @"40);
499
print_visible_char(@"80 + (s mod @"1000) mod @"40);
505
doing_special: boolean;
508
doing_special:=false;
512
procedure print(@!s:integer); {prints string |s|}
514
var j:pool_pointer; {current character code position}
515
@!nl:integer; {new-line character to restore}
516
begin if s>=str_ptr then s:="???" {this can't happen}
519
if s<0 then s:="???" {can't happen}
520
else begin if (selector>pseudo) and (not special_printing)
521
and (not message_printing) then
522
begin print_char(s); return; {internal strings are not expanded}
524
if (@<Character |s| is the current new-line character@>) then
525
if selector<pseudo then
526
begin print_ln; no_convert := false; return;
528
else if message_printing then
529
begin print_char(s); no_convert := false; return;
531
if (mubyte_log>0) and (not no_convert) and (mubyte_write[s]>0) then
533
else if xprn[s] or special_printing then
534
begin print_char(s); no_convert := false; return; end;
536
nl:=new_line_char; new_line_char:=-1;
537
{temporarily disable new-line character}
539
while j<str_start[s+1] do
540
begin print_char(so(str_pool[j])); incr(j);
542
new_line_char:=nl; return;
545
while j<str_start[s+1] do
546
begin print_char(so(str_pool[j])); incr(j);
550
procedure print(@!s:integer); {prints string |s|}
552
var j:pool_pointer; {current character code position}
553
@!nl:integer; {new-line character to restore}
554
begin if s>=str_ptr then s:="???" {this can't happen}
556
else if s<biggest_char then
557
if s<0 then s:="???" {can't happen}
558
else begin if selector>pseudo then
559
begin print_char(s); return; {internal strings are not expanded}
561
if (@<Character |s| is the current new-line character@>) then
562
if selector<pseudo then
563
begin print_ln; return;
571
j:=str_start_macro(s);
572
while j<str_start_macro(s+1) do
573
begin print_char(so(str_pool[j])); incr(j);
579
@ Control sequence names, file names, and strings constructed with
580
\.{\\string} might contain |ASCII_code| values that can't
581
be printed using |print_char|. Therefore we use |slow_print| for them:
584
procedure slow_print(@!s:integer); {prints string |s|}
585
var j:pool_pointer; {current character code position}
586
begin if (s>=str_ptr) or (s<256) then print(s)
587
else begin j:=str_start[s];
588
while j<str_start[s+1] do
589
begin print(so(str_pool[j])); incr(j);
594
@ Old versions of \TeX\ needed a procedure called |slow_print| whose function
595
is now subsumed by |print| and the new functionality of |print_char| and
596
|print_visible_char|. We retain the old name |slow_print| here as a
597
possible aid to future software arch\ae ologists.
599
@d slow_print == print
603
begin @<Set variable |c| to the current escape character@>;
604
if c>=0 then if c<256 then print(c);
606
begin @<Set variable |c| to the current escape character@>;
607
if c>=0 then if c<=biggest_char then print_char(c);
611
begin j:=str_start["m2d5c2l5x2v5i"]; v:=1000;
613
begin j:=str_start_macro("m2d5c2l5x2v5i"); v:=1000;
617
@p procedure print_current_string; {prints a yet-unmade string}
618
var j:pool_pointer; {points to current character code}
619
begin j:=str_start[str_ptr];
621
@p procedure print_current_string; {prints a yet-unmade string}
622
var j:pool_pointer; {points to current character code}
623
begin j:=str_start_macro(str_ptr);
627
k:=first; while k < last do begin print_buffer(k) end;
629
if last<>first then for k:=first to last-1 do print(buffer[k]);
633
@* \[6] Reporting errors.
635
@* \[6] Reporting errors.
639
begin edit_name_start:=str_start[edit_file.name_field];
640
edit_name_length:=str_start[edit_file.name_field+1] -
641
str_start[edit_file.name_field];
643
begin edit_name_start:=str_start_macro(edit_file.name_field);
644
edit_name_length:=str_start_macro(edit_file.name_field+1) -
645
str_start_macro(edit_file.name_field);
649
@* \[7] Arithmetic with scaled dimensions.
651
@* \[7] Arithmetic with scaled dimensions.
661
@d min_quarterword=0 {smallest allowable value in a |quarterword|}
662
@d max_quarterword=255 {largest allowable value in a |quarterword|}
663
@d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|}
664
@d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|}
666
@d min_quarterword=0 {smallest allowable value in a |quarterword|}
667
@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|}
668
@d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|}
669
@d max_halfword==@"3FFFFFFF {largest allowable value in a |halfword|}
673
if (min_quarterword>0)or(max_quarterword<127) then bad:=11;
674
if (min_halfword>0)or(max_halfword<32767) then bad:=12;
676
if (min_quarterword>0)or(max_quarterword<@"7FFF) then bad:=11;
677
if (min_halfword>0)or(max_halfword<@"3FFFFFFF) then bad:=12;
681
if max_quarterword-min_quarterword<255 then bad:=19;
683
if max_quarterword-min_quarterword<@"FFFF then bad:=19;
687
@* \[9] Dynamic memory allocation.
689
@* \[9] Dynamic memory allocation.
693
@* \[10] Data structures for boxes and their friends.
695
@* \[10] Data structures for boxes and their friends.
699
@d whatsit_node=8 {|type| of special extension nodes}
701
@d whatsit_node=8 {|type| of special extension nodes}
703
{ added stuff here for native_word and picture nodes }
704
@d native_word_node=40 {|subtype| in whatsits that hold native_font words
705
(0-3 are used for open, write, close, special; 4 is language; pdfTeX uses up through 30-something)
707
To support ``native'' fonts, we build |native_word_nodes|, which are variable size whatsits.
708
These have the same |width|, |depth|, and |height| fields as a |box_node|, at offsets 1-3,
709
and then a word containing a size field for the node, a font number, and a length.
710
Then there is a field containing two halfwords, a glyph count and a C pointer to a glyph info array;
711
these are set by |set_native_metrics|. Copying and freeing of these nodes needs to take account of this!
712
This is followed by |length| bytes, for the actual characters of the string.
713
(Yes, we count in bytes, even though what we store there is UTF-16.)
715
So |native_node_size|, which does not include any space for the actual text, is 6.}
717
@d deleted_native_node=41 {native words that have been superseded by their successors}
719
@d native_node_size=6 {size of a native_word node (plus the actual chars) -- see also xetex.h}
720
@d native_size(#)==mem[#+4].hh.b0
721
@d native_font(#)==mem[#+4].hh.b1
722
@d native_length(#)==mem[#+4].hh.rh
723
@d native_glyph_count(#)==mem[#+5].hh.lh
724
@d native_glyph_info_ptr(#)==mem[#+5].hh.rh
725
@d native_glyph_info_size=10 { number of bytes of info per glyph: 16-bit glyph ID, 32-bit x and y coords }
727
@d free_native_glyph_info(#) ==
729
if native_glyph_info_ptr(#) <> 0 then begin
730
libc_free(cast_to_ptr(native_glyph_info_ptr(#)));
731
native_glyph_info_ptr(#) := 0;
732
native_glyph_count(#) := 0;
736
@p procedure copy_native_glyph_info(src:pointer; dest:pointer);
737
var glyph_count:integer;
739
if native_glyph_info_ptr(src) <> 0 then begin
740
glyph_count := native_glyph_count(src);
741
native_glyph_info_ptr(dest) := cast_to_integer(xmalloc_array(char, glyph_count * native_glyph_info_size));
742
memcpy(cast_to_ptr(native_glyph_info_ptr(dest)), cast_to_ptr(native_glyph_info_ptr(src)), glyph_count * native_glyph_info_size);
743
native_glyph_count(dest) := glyph_count;
747
@ There are also |glyph_nodes|; these are like |native_word_nodes| in having |width|, |depth|, and |height| fields,
748
but then they contain a glyph ID rather than size and length fields, and there's no subsidiary C pointer.
751
@d native_glyph==native_length {in |glyph_node|s, we store the glyph number here}
753
@d pic_node=42 {|subtype| in whatsits that hold picture file references}
754
@d pdf_node=43 {|subtype| in whatsits that hold PDF page references}
755
@d glyph_node=44 {|subtype| in whatsits that hold glyph numbers}
757
@d pdfbox_crop = 1 { |pic_box_type| values in PDF nodes }
764
{Picture files are handled with nodes that include fields for the transform associated
765
with the picture, and a pathname for the picture file itself.
767
the |width|, |depth|, and |height| fields of a |box_node| at offsets 1-3. (|depth| will
768
always be zero, as it happens.)
770
So |pic_node_size|, which does not include any space for the picture file pathname, is 7.
772
pdf_nodes are just like pic_nodes, but generate a different xdv file code.}
774
@d pic_node_size=8 { must sync with xetex.h }
775
@d pic_path_length(#)==mem[#+4].hh.b0
776
@d pic_page(#)==mem[#+4].hh.b1
777
@d pic_box_type(#)==mem[#+4].hh.rh { for PDF, unused in picfile }
778
@d pic_transform1(#)==mem[#+5].hh.lh
779
@d pic_transform2(#)==mem[#+5].hh.rh
780
@d pic_transform3(#)==mem[#+6].hh.lh
781
@d pic_transform4(#)==mem[#+6].hh.rh
782
@d pic_transform5(#)==mem[#+7].hh.lh
783
@d pic_transform6(#)==mem[#+7].hh.rh
787
@* \[11] Memory layout.
789
@* \[11] Memory layout.
793
@* \[12] Displaying boxes.
795
@* \[12] Displaying boxes.
799
@ @<Print a short indication of the contents of node |p|@>=
801
hlist_node,vlist_node,ins_node,whatsit_node,mark_node,adjust_node,
802
unset_node: print("[]");
804
@ @<Print a short indication of the contents of node |p|@>=
806
hlist_node,vlist_node,ins_node,mark_node,adjust_node,
807
unset_node: print("[]");
808
whatsit_node: if subtype(p)=native_word_node then begin
809
if native_font(p)<>font_in_short_display then begin
810
print_esc(font_id_text(native_font(p)));
812
font_in_short_display:=native_font(p);
814
print_native_word(p);
820
@p procedure show_node_list(@!p:integer); {prints a node list symbolically}
822
var n:integer; {the number of items already printed at this level}
824
@p procedure show_node_list(@!p:integer); {prints a node list symbolically}
826
var n:integer; {the number of items already printed at this level}
827
i:integer; {temp index for printing chars of picfile paths}
831
@* \[15] The command codes.
833
@* \[15] The command codes.
837
@d math_given=69 {math code defined by \.{\\mathchardef}}
838
@d last_item=70 {most recent item ( \.{\\lastpenalty},
839
\.{\\lastkern}, \.{\\lastskip} )}
840
@d max_non_prefixed_command=70 {largest command code that can't be \.{\\global}}
842
@ The next codes are special; they all relate to mode-independent
843
assignment of values to \TeX's internal registers or tables.
844
Codes that are |max_internal| or less represent internal quantities
845
that might be expanded by `\.{\\the}'.
847
@d toks_register=71 {token list register ( \.{\\toks} )}
848
@d assign_toks=72 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)}
849
@d assign_int=73 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)}
850
@d assign_dimen=74 {user-defined length ( \.{\\hsize}, etc.~)}
851
@d assign_glue=75 {user-defined glue ( \.{\\baselineskip}, etc.~)}
852
@d assign_mu_glue=76 {user-defined muglue ( \.{\\thinmuskip}, etc.~)}
853
@d assign_font_dimen=77 {user-defined font dimension ( \.{\\fontdimen} )}
854
@d assign_font_int=78 {user-defined font integer ( \.{\\hyphenchar},
856
@d set_aux=79 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )}
857
@d set_prev_graf=80 {specify state info ( \.{\\prevgraf} )}
858
@d set_page_dimen=81 {specify state info ( \.{\\pagegoal}, etc.~)}
859
@d set_page_int=82 {specify state info ( \.{\\deadcycles},
860
\.{\\insertpenalties} )}
861
{( or \.{\\interactionmode} )}
862
@d set_box_dimen=83 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )}
863
@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )}
864
{(or \.{\\interlinepenalties}, etc.~)}
865
@d def_code=85 {define a character code ( \.{\\catcode}, etc.~)}
866
@d def_family=86 {declare math fonts ( \.{\\textfont}, etc.~)}
867
@d set_font=87 {set current font ( font identifiers )}
868
@d def_font=88 {define a font file ( \.{\\font} )}
869
@d register=89 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
870
@d max_internal=89 {the largest code that can follow \.{\\the}}
871
@d advance=90 {advance a register or parameter ( \.{\\advance} )}
872
@d multiply=91 {multiply a register or parameter ( \.{\\multiply} )}
873
@d divide=92 {divide a register or parameter ( \.{\\divide} )}
874
@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
875
{( or \.{\\protected} )}
876
@d let=94 {assign a command code ( \.{\\let}, \.{\\futurelet} )}
877
@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
878
{or \.{\\charsubdef}}
879
@d read_to_cs=96 {read into a control sequence ( \.{\\read} )}
880
{( or \.{\\readline} )}
881
@d def=97 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
882
@d set_box=98 {set a box ( \.{\\setbox} )}
883
@d hyph_data=99 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
884
@d set_interaction=100 {define level of interaction ( \.{\\batchmode}, etc.~)}
885
@d max_command=100 {the largest command code seen at |big_switch|}
887
@d math_given=69 {math code defined by \.{\\mathchardef}}
888
@d XeTeX_math_given=70
889
@d last_item=71 {most recent item ( \.{\\lastpenalty},
890
\.{\\lastkern}, \.{\\lastskip} )}
891
@d max_non_prefixed_command=71 {largest command code that can't be \.{\\global}}
893
@ The next codes are special; they all relate to mode-independent
894
assignment of values to \TeX's internal registers or tables.
895
Codes that are |max_internal| or less represent internal quantities
896
that might be expanded by `\.{\\the}'.
898
@d toks_register=72 {token list register ( \.{\\toks} )}
899
@d assign_toks=73 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)}
900
@d assign_int=74 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)}
901
@d assign_dimen=75 {user-defined length ( \.{\\hsize}, etc.~)}
902
@d assign_glue=76 {user-defined glue ( \.{\\baselineskip}, etc.~)}
903
@d assign_mu_glue=77 {user-defined muglue ( \.{\\thinmuskip}, etc.~)}
904
@d assign_font_dimen=78 {user-defined font dimension ( \.{\\fontdimen} )}
905
@d assign_font_int=79 {user-defined font integer ( \.{\\hyphenchar},
907
@d set_aux=80 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )}
908
@d set_prev_graf=81 {specify state info ( \.{\\prevgraf} )}
909
@d set_page_dimen=82 {specify state info ( \.{\\pagegoal}, etc.~)}
910
@d set_page_int=83 {specify state info ( \.{\\deadcycles},
911
\.{\\insertpenalties} )}
912
{( or \.{\\interactionmode} )}
913
@d set_box_dimen=84 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )}
914
@d set_shape=85 {specify fancy paragraph shape ( \.{\\parshape} )}
915
{(or \.{\\interlinepenalties}, etc.~)}
916
@d def_code=86 {define a character code ( \.{\\catcode}, etc.~)}
917
@d XeTeX_def_code=87 {\.{\\XeTeXmathcode}, \.{\\XeTeXdelcode}}
918
@d def_family=88 {declare math fonts ( \.{\\textfont}, etc.~)}
919
@d set_font=89 {set current font ( font identifiers )}
920
@d def_font=90 {define a font file ( \.{\\font} )}
921
@d register=91 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
922
@d max_internal=91 {the largest code that can follow \.{\\the}}
923
@d advance=92 {advance a register or parameter ( \.{\\advance} )}
924
@d multiply=93 {multiply a register or parameter ( \.{\\multiply} )}
925
@d divide=94 {divide a register or parameter ( \.{\\divide} )}
926
@d prefix=95 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
927
{( or \.{\\protected} )}
928
@d let=96 {assign a command code ( \.{\\let}, \.{\\futurelet} )}
929
@d shorthand_def=97 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
930
{or \.{\\charsubdef}}
931
@d read_to_cs=98 {read into a control sequence ( \.{\\read} )}
932
{( or \.{\\readline} )}
933
@d def=99 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
934
@d set_box=100 {set a box ( \.{\\setbox} )}
935
@d hyph_data=101 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
936
@d set_interaction=102 {define level of interaction ( \.{\\batchmode}, etc.~)}
937
@d max_command=102 {the largest command code seen at |big_switch|}
941
@* \[17] The table of equivalents.
943
@* \[17] The table of equivalents.
947
In the first region we have 256 equivalents for ``active characters'' that
948
act as control sequences, followed by 256 equivalents for single-character
951
In the first region we have |number_chars| equivalents for ``active characters''
952
that act as control sequences, followed by |number_chars| equivalents for
953
single-character control sequences.
957
@d single_base=active_base+256 {equivalents of one-character control sequences}
958
@d null_cs=single_base+256 {equivalent of \.{\\csname\\endcsname}}
960
@d single_base=active_base+number_chars
961
{equivalents of one-character control sequences}
962
@d null_cs=single_base+number_chars {equivalent of \.{\\csname\\endcsname}}
966
@ Region 3 of |eqtb| contains the 256 \.{\\skip} registers, as well as the
967
glue parameters defined here. It is important that the ``muskip''
968
parameters have larger numbers than the others.
970
@ Region 3 of |eqtb| contains the |number_regs| \.{\\skip} registers,
971
as well as the glue parameters defined here. It is important that the
972
``muskip'' parameters have larger numbers than the others.
976
@d par_fill_skip_code=14 {glue on last line of paragraph}
977
@d thin_mu_skip_code=15 {thin space in math formula}
978
@d med_mu_skip_code=16 {medium space in math formula}
979
@d thick_mu_skip_code=17 {thick space in math formula}
980
@d glue_pars=18 {total number of glue parameters}
982
@d par_fill_skip_code=14 {glue on last line of paragraph}
983
@d XeTeX_linebreak_skip_code=15 {glue introduced at potential linebreak location}
984
@d thin_mu_skip_code=16 {thin space in math formula}
985
@d med_mu_skip_code=17 {medium space in math formula}
986
@d thick_mu_skip_code=18 {thick space in math formula}
987
@d glue_pars=19 {total number of glue parameters}
991
@d skip_base=glue_base+glue_pars {table of 256 ``skip'' registers}
992
@d mu_skip_base=skip_base+256 {table of 256 ``muskip'' registers}
993
@d local_base=mu_skip_base+256 {beginning of region 4}
995
@d skip_base=glue_base+glue_pars {table of |number_regs| ``skip'' registers}
996
@d mu_skip_base=skip_base+number_regs
997
{table of |number_regs| ``muskip'' registers}
998
@d local_base=mu_skip_base+number_regs {beginning of region 4}
1002
@d par_fill_skip==glue_par(par_fill_skip_code)
1004
@d par_fill_skip==glue_par(par_fill_skip_code)
1005
@d XeTeX_linebreak_skip==glue_par(XeTeX_linebreak_skip_code)
1009
par_fill_skip_code: print_esc("parfillskip");
1011
par_fill_skip_code: print_esc("parfillskip");
1012
XeTeX_linebreak_skip_code: print_esc("XeTeXlinebreakskip");
1016
primitive("parfillskip",assign_glue,glue_base+par_fill_skip_code);@/
1017
@!@:par_fill_skip_}{\.{\\parfillskip} primitive@>
1019
primitive("parfillskip",assign_glue,glue_base+par_fill_skip_code);@/
1020
@!@:par_fill_skip_}{\.{\\parfillskip} primitive@>
1021
primitive("XeTeXlinebreakskip",assign_glue,glue_base+XeTeX_linebreak_skip_code);@/
1025
@d toks_base=etex_toks {table of 256 token list registers}
1027
@d etex_pen_base=toks_base+256 {start of table of \eTeX's penalties}
1028
@d inter_line_penalties_loc=etex_pen_base {additional penalties between lines}
1029
@d club_penalties_loc=etex_pen_base+1 {penalties for creating club lines}
1030
@d widow_penalties_loc=etex_pen_base+2 {penalties for creating widow lines}
1031
@d display_widow_penalties_loc=etex_pen_base+3 {ditto, just before a display}
1032
@d etex_pens=etex_pen_base+4 {end of table of \eTeX's penalties}
1034
@d box_base=etex_pens {table of 256 box registers}
1035
@d cur_font_loc=box_base+256 {internal font number outside math mode}
1036
@d xord_code_base=cur_font_loc+1
1037
@d xchr_code_base=xord_code_base+1
1038
@d xprn_code_base=xchr_code_base+1
1039
@d math_font_base=xprn_code_base+1
1040
@d cat_code_base=math_font_base+48
1041
{table of 256 command codes (the ``catcodes'')}
1042
@d lc_code_base=cat_code_base+256 {table of 256 lowercase mappings}
1043
@d uc_code_base=lc_code_base+256 {table of 256 uppercase mappings}
1044
@d sf_code_base=uc_code_base+256 {table of 256 spacefactor mappings}
1045
@d math_code_base=sf_code_base+256 {table of 256 math mode mappings}
1046
@d char_sub_code_base=math_code_base+256 {table of character substitutions}
1047
@d int_base=char_sub_code_base+256 {beginning of region 5}
1049
@d toks_base=etex_toks {table of number_regs token list registers}
1051
@d etex_pen_base=toks_base+number_regs {start of table of \eTeX's penalties}
1052
@d inter_line_penalties_loc=etex_pen_base {additional penalties between lines}
1053
@d club_penalties_loc=etex_pen_base+1 {penalties for creating club lines}
1054
@d widow_penalties_loc=etex_pen_base+2 {penalties for creating widow lines}
1055
@d display_widow_penalties_loc=etex_pen_base+3 {ditto, just before a display}
1056
@d etex_pens=etex_pen_base+4 {end of table of \eTeX's penalties}
1058
@d box_base=etex_pens {table of number_regs box registers}
1059
@d cur_font_loc=box_base+number_regs {internal font number outside math mode}
1060
@d xord_code_base=cur_font_loc+1
1061
@d xchr_code_base=xord_code_base+1
1062
@d xprn_code_base=xchr_code_base+1
1063
@d math_font_base=xprn_code_base+1
1064
@d cat_code_base=math_font_base+number_math_fonts
1065
{table of number_chars command codes (the ``catcodes'')}
1066
@d lc_code_base=cat_code_base+number_chars {table of number_chars lowercase mappings}
1067
@d uc_code_base=lc_code_base+number_chars {table of number_chars uppercase mappings}
1068
@d sf_code_base=uc_code_base+number_chars {table of number_chars spacefactor mappings}
1069
@d math_code_base=sf_code_base+number_chars {table of number_chars math mode mappings}
1070
@d char_sub_code_base=math_code_base+number_chars {table of character substitutions}
1071
@d int_base=char_sub_code_base+number_chars {beginning of region 5}
1075
@d var_code==@'70000 {math code meaning ``use the current family''}
1077
@d var_fam_class = 7
1078
@d active_math_char = @"1FFFFF
1079
@d is_active_math_char(#) == math_char_field(#) = active_math_char
1080
@d is_var_family(#) == math_class_field(#) = 7
1084
for k:=output_routine_loc to toks_base+255 do
1086
for k:=output_routine_loc to toks_base+number_regs-1 do
1090
for k:=box_base+1 to box_base+255 do eqtb[k]:=eqtb[box_base];
1092
for k:=box_base+1 to box_base+number_regs-1 do eqtb[k]:=eqtb[box_base];
1096
for k:=math_font_base to math_font_base+47 do eqtb[k]:=eqtb[cur_font_loc];
1098
for k:=math_font_base to math_font_base+number_math_fonts-1 do eqtb[k]:=eqtb[cur_font_loc];
1104
for k:=0 to number_chars-1 do
1108
for k:="0" to "9" do math_code(k):=hi(k+var_code);
1110
for k:="0" to "9" do math_code(k):=hi(k + set_class_field(var_fam_class));
1114
math_code(k):=hi(k+var_code+@"100);
1115
math_code(k+"a"-"A"):=hi(k+"a"-"A"+var_code+@"100);@/
1117
math_code(k) := hi(k + set_family_field(1) + set_class_field(var_fam_class));
1118
math_code(k+"a"-"A") := hi(k+"a"-"A" + set_family_field(1) + set_class_field(var_fam_class));@/
1122
begin if n=cur_font_loc then print("current font")
1123
else if n<math_font_base+16 then
1124
begin print_esc("textfont"); print_int(n-math_font_base);
1126
else if n<math_font_base+32 then
1127
begin print_esc("scriptfont"); print_int(n-math_font_base-16);
1129
else begin print_esc("scriptscriptfont"); print_int(n-math_font_base-32);
1131
begin if n=cur_font_loc then print("current font")
1132
else if n<math_font_base+script_size then
1133
begin print_esc("textfont"); print_int(n-math_font_base);
1135
else if n<math_font_base+script_script_size then
1136
begin print_esc("scriptfont"); print_int(n-math_font_base-script_size);
1138
else begin print_esc("scriptscriptfont");
1139
print_int(n-math_font_base-script_script_size);
1143
@d eTeX_state_code=etex_int_base+9 {\eTeX\ state variables}
1144
@d etex_int_pars=eTeX_state_code+eTeX_states {total number of \eTeX's integer parameters}
1146
@d XeTeX_linebreak_locale_code=etex_int_base+9 {string number of locale to use for linebreak locations}
1147
@d XeTeX_linebreak_penalty_code=etex_int_base+10 {penalty to use at locale-dependent linebreak locations}
1148
@d eTeX_state_code=etex_int_base+11 {\eTeX\ state variables}
1149
@d etex_int_pars=eTeX_state_code+eTeX_states {total number of \eTeX's integer parameters}
1153
@d count_base=int_base+int_pars {256 user \.{\\count} registers}
1154
@d del_code_base=count_base+256 {256 delimiter code mappings}
1155
@d dimen_base=del_code_base+256 {beginning of region 6}
1157
@d count_base=int_base+int_pars {number_regs user \.{\\count} registers}
1158
@d del_code_base=count_base+number_regs {number_chars delimiter code mappings}
1159
@d dimen_base=del_code_base+number_chars {beginning of region 6}
1163
@d saving_hyph_codes==int_par(saving_hyph_codes_code)
1165
@d saving_hyph_codes==int_par(saving_hyph_codes_code)
1166
@d XeTeX_linebreak_locale==int_par(XeTeX_linebreak_locale_code)
1167
@d XeTeX_linebreak_penalty==int_par(XeTeX_linebreak_penalty_code)
1171
error_context_lines_code:print_esc("errorcontextlines");
1173
error_context_lines_code:print_esc("errorcontextlines");
1174
{XeTeX_linebreak_locale_code:print_esc("XeTeXlinebreaklocale");}
1175
XeTeX_linebreak_penalty_code:print_esc("XeTeXlinebreakpenalty");
1179
primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/
1180
@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
1182
primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/
1183
@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
1184
primitive("XeTeXlinebreakpenalty",assign_int,int_base+XeTeX_linebreak_penalty_code);@/
1188
for k:=0 to 255 do del_code(k):=-1;
1189
del_code("."):=0; {this null delimiter is used in error recovery}
1191
for k:=0 to number_chars-1 do del_code(k):=-1;
1192
del_code("."):=0; {this null delimiter is used in error recovery}
1196
@ The final region of |eqtb| contains the dimension parameters defined
1197
here, and the 256 \.{\\dimen} registers.
1199
@ The final region of |eqtb| contains the dimension parameters defined
1200
here, and the |number_regs| \.{\\dimen} registers.
1204
@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking}
1205
@d dimen_pars=21 {total number of dimension parameters}
1207
@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking}
1208
@d pdf_page_width_code=21 {page width of the PDF output}
1209
@d pdf_page_height_code=22 {page height of the PDF output}
1210
@d dimen_pars=23 {total number of dimension parameters}
1214
@d scaled_base=dimen_base+dimen_pars
1215
{table of 256 user-defined \.{\\dimen} registers}
1216
@d eqtb_size=scaled_base+255 {largest subscript of |eqtb|}
1218
@d scaled_base=dimen_base+dimen_pars
1219
{table of |number_regs| user-defined \.{\\dimen} registers}
1220
@d eqtb_size=scaled_base+biggest_reg {largest subscript of |eqtb|}
1224
@d emergency_stretch==dimen_par(emergency_stretch_code)
1226
@d emergency_stretch==dimen_par(emergency_stretch_code)
1227
@d pdf_page_width == dimen_par(pdf_page_width_code)
1228
@d pdf_page_height == dimen_par(pdf_page_height_code)
1232
emergency_stretch_code:print_esc("emergencystretch");
1234
emergency_stretch_code:print_esc("emergencystretch");
1235
pdf_page_width_code: print_esc("pdfpagewidth");
1236
pdf_page_height_code: print_esc("pdfpageheight");
1240
primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/
1241
@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@>
1243
primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/
1244
@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@>
1246
primitive("pdfpagewidth",assign_dimen,dimen_base+pdf_page_width_code);@/
1247
@!@:pdf_page_width_}{\.{\\pdfpagewidth} primitive@>
1248
primitive("pdfpageheight",assign_dimen,dimen_base+pdf_page_height_code);@/
1249
@!@:pdf_page_height_}{\.{\\pdfpageheight} primitive@>
1253
for q:=active_base to box_base+255 do
1255
for q:=active_base to box_base+biggest_reg do
1259
@* \[18] The hash table.
1261
@* \[18] The hash table.
1265
while pool_ptr>str_start[str_ptr] do
1267
while pool_ptr>str_start_macro(str_ptr) do
1271
The conversion from control sequence to byte sequence for enc\TeX is
1272
implemented here. Of course, the simplest way is to implement an array
1273
of string pointers with |hash_size| length, but we assume that only a
1274
few control sequences will need to be converted. So |mubyte_cswrite|,
1275
an array with only 128 items, is used. The items point to the token
1276
lists. First token includes a csname number and the second points the
1277
string to be output. The third token includes the number of another
1278
csname and fourth token its pointer to the string etc. We need to do
1279
the sequential searching in one of the 128 token lists.
1284
else begin k:=str_start[s]; l:=str_start[s+1]-k;
1286
else begin k:=str_start_macro(s); l:=str_start_macro(s+1)-k;
1290
primitive("delimiter",delim_num,0);@/
1292
primitive("delimiter",delim_num,0);@/
1293
primitive("XeTeXdelimiter",delim_num,1);@/
1297
primitive("mathaccent",math_accent,0);@/
1299
primitive("mathaccent",math_accent,0);@/
1300
primitive("XeTeXmathaccent",math_accent,1);@/
1304
primitive("mathchar",math_char_num,0);@/
1305
@!@:math_char_}{\.{\\mathchar} primitive@>
1307
primitive("mathchar",math_char_num,0);@/
1308
primitive("XeTeXmathcharnum",math_char_num,1);@/
1309
primitive("XeTeXmathchar",math_char_num,2);@/
1310
@!@:math_char_}{\.{\\mathchar} primitive@>
1314
primitive("radical",radical,0);@/
1316
primitive("radical",radical,0);@/
1317
primitive("XeTeXradical",radical,1);@/
1321
primitive("relax",relax,256); {cf.\ |scan_file_name|}
1323
primitive("relax",relax,too_big_char); {cf.\ |scan_file_name|}
1327
delim_num: print_esc("delimiter");
1329
delim_num: if chr_code=1 then print_esc("XeTeXdelimiter")
1330
else print_esc("delimiter");
1334
end_cs_name: if chr_code = 10 then print_esc("endmubyte")
1335
else print_esc("endcsname");
1337
end_cs_name: print_esc("endcsname");
1341
math_accent: print_esc("mathaccent");
1343
math_accent: if chr_code=1 then print_esc("XeTeXmathaccent")
1344
else print_esc("mathaccent");
1348
math_char_num: print_esc("mathchar");
1350
math_char_num: if chr_code=2 then print_esc("XeTeXmathchar")
1351
else if chr_code=1 then print_esc("XeTeXmathcharnum")
1352
else print_esc("mathchar");
1356
radical: print_esc("radical");
1358
radical: if chr_code=1 then print_esc("XeTeXradical") else print_esc("radical");
1362
@* \[19] Saving and restoring equivalents.
1364
@* \[19] Saving and restoring equivalents.
1367
-- based on Omega; not needed with new xetex delimiter coding
1369
@ The |eq_define| and |eq_word_define| routines take care of local definitions.
1372
procedure eq_word_define1(@!p:pointer;@!w:integer);
1374
begin if eTeX_ex and(read_cint1(eqtb[p])=w) then
1375
begin assign_trace(p,"reassigning")@;@/
1378
assign_trace(p,"changing")@;@/
1379
if xeq_level[p]<>cur_level then
1380
begin eq_save(p,xeq_level[p]); xeq_level[p]:=cur_level;
1382
set_cint1(eqtb[p],w);
1383
assign_trace(p,"into")@;@/
1386
@ The |eq_define| and |eq_word_define| routines take care of local definitions.
1390
@ Subroutine |save_for_after| puts a token on the stack for save-keeping.
1393
procedure geq_word_define1(@!p:pointer;@!w:integer); {global |eq_word_define1|}
1394
begin assign_trace(p,"globally changing")@;@/
1395
begin set_cint1(eqtb[p],w); xeq_level[p]:=level_one;
1397
assign_trace(p,"into")@;@/
1400
@ Subroutine |save_for_after| puts a token on the stack for save-keeping.
1404
@* \[20] Token lists.
1406
@* \[20] Token lists.
1410
A \TeX\ token is either a character or a control sequence, and it is
1412
represented internally in one of two ways: (1)~A character whose ASCII
1413
code number is |c| and whose command code is |m| is represented as the
1414
number $2^8m+c$; the command code is in the range |1<=m<=14|. (2)~A control
1415
sequence whose |eqtb| address is |p| is represented as the number
1416
|cs_token_flag+p|. Here |cs_token_flag=@t$2^{12}-1$@>| is larger than
1417
$2^8m+c$, yet it is small enough that |cs_token_flag+p< max_halfword|;
1418
thus, a token fits comfortably in a halfword.
1420
A \TeX\ token is either a character or a control sequence, and it is
1422
represented internally in one of two ways: (1)~A character whose ASCII
1423
code number is |c| and whose command code is |m| is represented as the
1424
number $2^16m+c$; the command code is in the range |1<=m<=14|. (2)~A control
1425
sequence whose |eqtb| address is |p| is represented as the number
1426
|cs_token_flag+p|. Here |cs_token_flag=@t$2^{20}-1$@>| is larger than
1427
$2^8m+c$, yet it is small enough that |cs_token_flag+p< max_halfword|;
1428
thus, a token fits comfortably in a halfword.
1432
@d cs_token_flag==@'7777 {amount added to the |eqtb| location in a
1433
token that stands for a control sequence; is a multiple of~256, less~1}
1434
@d left_brace_token=@'0400 {$2^8\cdot|left_brace|$}
1435
@d left_brace_limit=@'1000 {$2^8\cdot(|left_brace|+1)$}
1436
@d right_brace_token=@'1000 {$2^8\cdot|right_brace|$}
1437
@d right_brace_limit=@'1400 {$2^8\cdot(|right_brace|+1)$}
1438
@d math_shift_token=@'1400 {$2^8\cdot|math_shift|$}
1439
@d tab_token=@'2000 {$2^8\cdot|tab_mark|$}
1440
@d out_param_token=@'2400 {$2^8\cdot|out_param|$}
1441
@d space_token=@'5040 {$2^8\cdot|spacer|+|" "|$}
1442
@d letter_token=@'5400 {$2^8\cdot|letter|$}
1443
@d other_token=@'6000 {$2^8\cdot|other_char|$}
1444
@d match_token=@'6400 {$2^8\cdot|match|$}
1445
@d end_match_token=@'7000 {$2^8\cdot|end_match|$}
1446
@d protected_token=@'7001 {$2^8\cdot|end_match|+1$}
1448
@d cs_token_flag=@"FFFFF {amount added to the |eqtb| location in a
1449
token that stands for a control sequence; is a multiple of~65536, less~1}
1450
@d max_char_val=@"10000 {to separate char and command code}
1451
@d left_brace_token=@"10000 {$2^16\cdot|left_brace|$}
1452
@d left_brace_limit=@"20000 {$2^16\cdot(|left_brace|+1)$}
1453
@d right_brace_token=@"20000 {$2^16\cdot|right_brace|$}
1454
@d right_brace_limit=@"30000 {$2^16\cdot(|right_brace|+1)$}
1455
@d math_shift_token=@"30000 {$2^16\cdot|math_shift|$}
1456
@d tab_token=@"40000 {$2^16\cdot|tab_mark|$}
1457
@d out_param_token=@"50000 {$2^16\cdot|out_param|$}
1458
@d space_token=@"A0020 {$2^16\cdot|spacer|+|" "|$}
1459
@d letter_token=@"B0000 {$2^16\cdot|letter|$}
1460
@d other_token=@"C0000 {$2^16\cdot|other_char|$}
1461
@d match_token=@"D0000 {$2^16\cdot|match|$}
1462
@d end_match_token=@"E0000 {$2^16\cdot|end_match|$}
1464
@d protected_token=end_match_token+1 {$2^8\cdot|end_match|+1$}
1468
else begin m:=info(p) div @'400; c:=info(p) mod @'400;
1470
else begin m:=info(p) div max_char_val; c:=info(p) mod max_char_val;
1474
@* \[21] Introduction to the syntactic routines.
1476
@* \[21] Introduction to the syntactic routines.
1480
procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
1481
var n:integer; {temp variable}
1483
procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
1484
var n:integer; {temp variable}
1485
@!font_name_str:str_number; {local vars for \.{\\fontname} quoting extension}
1486
@!quote_char:UTF16_code;
1490
@* \[22] Input stacks and states.
1492
@* \[22] Input stacks and states.
1496
@!input_file : ^alpha_file;
1498
@!input_file : ^unicode_file;
1502
for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]);
1504
for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2}
1505
if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3);
1506
for q:=first_count to p-1 do print_char(trick_buf[q mod error_line]);
1508
for q:=p to first_count-1 do print_visible_char(trick_buf[q mod error_line]);
1510
for q:=1 to n do print_visible_char(" "); {print |n| spaces to begin line~2}
1511
if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3);
1512
for q:=first_count to p-1 do print_visible_char(trick_buf[q mod error_line]);
1516
@* \[23] Maintaining the input stacks.
1518
@* \[23] Maintaining the input stacks.
1522
if name>17 then a_close(cur_file); {forget it}
1524
if name>17 then u_close(cur_file); {forget it}
1528
@* \[24] Getting the next token.
1530
@* \[24] Getting the next token.
1534
primitive("par",par_end,256); {cf. |scan_file_name|}
1536
primitive("par",par_end,too_big_char); {cf. |scan_file_name|}
1540
@!c,@!cc:ASCII_code; {constituents of a possible expanded code}
1541
@!d:2..3; {number of excess characters in an expanded code}
1543
@!c,@!cc,@!ccc,@!cccc:ASCII_code; {constituents of a possible expanded code}
1544
@!d:2..7; {number of excess characters in an expanded code}
1549
if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10;
1550
if cc<="9" then cur_chr:=16*cur_chr+cc-"0"
1551
else cur_chr:=16*cur_chr+cc-"a"+10
1554
if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10;
1555
if cc<="9" then cur_chr:=16*cur_chr+cc-"0"
1556
else cur_chr:=16*cur_chr+cc-"a"+10
1557
@d long_hex_to_cur_chr==
1558
if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10;
1559
if cc<="9" then cur_chr:=16*cur_chr+cc-"0"
1560
else cur_chr:=16*cur_chr+cc-"a"+10;
1561
if ccc<="9" then cur_chr:=16*cur_chr+ccc-"0"
1562
else cur_chr:=16*cur_chr+ccc-"a"+10;
1563
if cccc<="9" then cur_chr:=16*cur_chr+cccc-"0"
1564
else cur_chr:=16*cur_chr+cccc-"a"+10
1568
begin c:=buffer[loc+1]; @+if c<@'200 then {yes we have an expanded char}
1570
begin if (cur_chr=buffer[loc+1]) and (cur_chr=buffer[loc+2]) and
1571
((loc+6)<=limit) then
1572
begin c:=buffer[loc+3]; cc:=buffer[loc+4];
1573
ccc:=buffer[loc+5]; cccc:=buffer[loc+6];
1574
if is_hex(c) and is_hex(cc) and is_hex(ccc) and is_hex(cccc) then
1575
begin loc:=loc+7; long_hex_to_cur_chr; goto reswitch;
1578
c:=buffer[loc+1]; @+if c<@'200 then {yes we have an expanded char}
1582
begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then
1583
begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present}
1585
if is_hex(c) then @+if k+2<=limit then
1586
begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d);
1589
begin hex_to_cur_chr; buffer[k-1]:=cur_chr;
1591
else if c<@'100 then buffer[k-1]:=c+@'100
1592
else buffer[k-1]:=c-@'100;
1593
limit:=limit-d; first:=first-d;
1595
begin buffer[k]:=buffer[k+d]; incr(k);
1602
begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then
1603
begin if (cur_chr=buffer[k+1]) and (cur_chr=buffer[k+2]) and
1605
begin c:=buffer[k+3]; cc:=buffer[k+4];
1606
ccc:=buffer[k+5]; cccc:=buffer[k+6];
1607
if is_hex(c) and is_hex(cc) and is_hex(ccc) and is_hex(cccc) then
1608
begin d:=7; long_hex_to_cur_chr; buffer[k-1]:=cur_chr;
1610
begin buffer[k]:=buffer[k+d]; incr(k);
1616
c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present}
1619
if is_hex(c) then @+if k+2<=limit then
1620
begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d);
1623
begin hex_to_cur_chr; buffer[k-1]:=cur_chr;
1625
else if c<@'100 then buffer[k-1]:=c+@'100
1626
else buffer[k-1]:=c-@'100;
1627
limit:=limit-d; first:=first-d;
1629
begin buffer[k]:=buffer[k+d]; incr(k);
1639
else begin cur_cmd:=t div @'400; cur_chr:=t mod @'400;
1641
else begin cur_cmd:=t div max_char_val; cur_chr:=t mod max_char_val;
1645
@d no_expand_flag=257 {this characterizes a special variant of |relax|}
1647
@d no_expand_flag=special_char {this characterizes a special variant of |relax|}
1652
while k < limit do begin print_buffer(k) end;
1654
if start<limit then for k:=start to limit-1 do print(buffer[k]);
1658
if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
1660
if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr
1664
begin eq_define(cur_cs,relax,256); {N.B.: The |save_stack| might change}
1666
begin eq_define(cur_cs,relax,too_big_char);
1667
{N.B.: The |save_stack| might change}
1671
buffer[j]:=info(p) mod @'400; incr(j); p:=link(p);
1673
buffer[j]:=info(p) mod max_char_val; incr(j); p:=link(p);
1677
done: if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
1679
done: if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr
1683
if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
1685
if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr
1689
if (info(r)>match_token+255)or(info(r)<match_token) then s:=null
1691
if (info(r)>=end_match_token)or(info(r)<match_token) then s:=null
1695
@* \[26] Basic scanning subroutines.
1697
@* \[26] Basic scanning subroutines.
1701
begin p:=backup_head; link(p):=null; k:=str_start[s];
1702
while k<str_start[s+1] do
1704
begin p:=backup_head; link(p):=null;
1705
if s<too_big_char then begin
1707
begin get_x_token; {recursion is possible here}
1710
((cur_chr=s)or(cur_chr=s-"a"+"A")) then
1711
begin store_new_token(cur_tok);
1712
flush_list(link(backup_head)); scan_keyword:=true; return;
1714
else if (cur_cmd<>spacer)or(p<>backup_head) then
1716
if p<>backup_head then back_list(link(backup_head));
1717
scan_keyword:=false; return;
1721
k:=str_start_macro(s);
1722
while k<str_start_macro(s+1) do
1726
@!cur_val:integer; {value returned by numeric scanners}
1728
@!cur_val:integer; {value returned by numeric scanners}
1729
@!cur_val1:integer; {value returned by numeric scanners}
1733
var m:halfword; {|chr_code| part of the operand token}
1735
var m:halfword; {|chr_code| part of the operand token}
1736
n, k, kk: integer; {accumulators}
1740
def_code: @<Fetch a character code from some table@>;
1742
def_code: @<Fetch a character code from some table@>;
1746
if m=math_code_base then begin
1747
scanned_result(ho(math_code(cur_val)))(int_val)
1749
else if m=math_code_base+1 then begin
1750
print_err("Can't use \XeTeXmathcode as a number");
1751
help2("\XeTeXmathcode is for setting a mathcode from separate values;")@/
1752
("use \XeTeXmathcodenum to access them as single values."); error;
1753
scanned_result(0)(int_val)
1755
else if m=del_code_base then begin
1756
scanned_result(ho(del_code(cur_val)))(int_val)
1758
print_err("Can't use \XeTeXdelcode as a number");
1759
help2("\XeTeXdelcode is for setting a delcode from separate values;")@/
1760
("use \XeTeXdelcodenum to access them as single values."); error;
1761
scanned_result(0)(int_val);
1767
if m=xord_code_base then scanned_result(xord[cur_val])(int_val)
1768
else if m=xchr_code_base then scanned_result(xchr[cur_val])(int_val)
1769
else if m=xprn_code_base then scanned_result(xprn[cur_val])(int_val)
1770
else if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val)
1772
if m=math_code_base then begin
1773
cur_val1:=ho(math_code(cur_val));
1774
if is_active_math_char(cur_val1) then
1776
else if (math_class_field(cur_val1)>7) or
1777
(math_fam_field(cur_val1)>15) or
1778
(math_char_field(cur_val1)>255) then
1779
begin print_err("Extended mathchar used as mathchar");
1781
help2("A mathchar number must be between 0 and ""7FFF.")@/
1782
("I changed this one to zero."); int_error(cur_val1); cur_val1:=0;
1784
cur_val1:=(math_class_field(cur_val1)*@"1000) +
1785
(math_fam_field(cur_val1)*@"100) +
1786
math_char_field(cur_val1);
1787
scanned_result(cur_val1)(int_val)
1789
else if m=del_code_base then begin
1790
cur_val1:=del_code(cur_val);
1791
if cur_val1>=@"40000000 then begin
1792
print_err("Extended delcode used as delcode");
1794
help2("A delimiter code must be between 0 and ""7FFFFFF.")@/
1795
("I changed this one to zero."); error;
1796
scanned_result(0)(int_val);
1798
scanned_result(cur_val1)(int_val);
1804
@d eTeX_dim=eTeX_int+8 {first of \eTeX\ codes for dimensions}
1807
@d XeTeX_int=eTeX_int+8 {first of \XeTeX\ codes for integers}
1809
@d eTeX_dim=XeTeX_int+29 {first of \eTeX\ codes for dimensions}
1810
{changed for \XeTeX\ to make room for \XeTeX\ integers}
1814
procedure scan_eight_bit_int;
1816
if (cur_val<0)or(cur_val>255) then
1817
begin print_err("Bad register code");
1818
@.Bad register code@>
1819
help2("A register number must be between 0 and 255.")@/
1821
procedure scan_eight_bit_int; {only used for insertion numbers now}
1823
if (cur_val<0)or(cur_val>255) then
1824
begin print_err("Bad register code");
1825
@.Bad register code@>
1826
help2("An insertion number must be between 0 and 255.")@/
1830
procedure scan_char_num;
1832
if (cur_val<0)or(cur_val>255) then
1834
procedure scan_usv_num;
1836
if (cur_val<0)or(cur_val>@"10FFFF) then
1837
begin print_err("Bad USV code");
1838
@.Bad character code@>
1839
help2("A Unicode Scalar Value must be between 0 and ""10FFFF.")@/
1840
("I changed this one to zero."); int_error(cur_val); cur_val:=0;
1844
procedure scan_char_num;
1846
if (cur_val<0)or(cur_val>biggest_char) then
1850
help2("A character number must be between 0 and 255.")@/
1852
help2("A character number must be between 0 and 65535.")@/
1856
procedure scan_four_bit_int;
1858
procedure scan_xetex_math_char_int;
1860
if is_active_math_char(cur_val) then begin
1861
if cur_val <> active_math_char then begin
1862
print_err("Bad active XeTeX math code");
1863
help2("Since I ignore class and family for active math chars,")@/
1864
("I changed this one to ""1FFFFF."); int_error(cur_val);
1865
cur_val := active_math_char;
1867
end else if math_char_field(cur_val) > @"10FFFF then begin
1868
print_err("Bad XeTeX math character code");
1869
help2("Since I expected a character number between 0 and ""10FFFF,")@/
1870
("I changed this one to zero."); int_error(cur_val); cur_val:=0;
1874
procedure scan_math_class_int;
1876
if (cur_val<0)or(cur_val>7) then
1877
begin print_err("Bad math class");
1879
help2("Since I expected to read a number between 0 and 7,")@/
1880
("I changed this one to zero."); int_error(cur_val); cur_val:=0;
1884
procedure scan_math_fam_int;
1886
if (cur_val<0)or(cur_val>number_math_families-1) then
1887
begin print_err("Bad math family");
1889
help2("Since I expected to read a number between 0 and 255,")@/
1890
("I changed this one to zero."); int_error(cur_val); cur_val:=0;
1894
procedure scan_four_bit_int;
1898
procedure scan_twenty_seven_bit_int;
1900
if (cur_val<0)or(cur_val>@'777777777) then
1901
begin print_err("Bad delimiter code");
1902
@.Bad delimiter code@>
1903
help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/
1904
("I changed this one to zero."); int_error(cur_val); cur_val:=0;
1908
procedure scan_delimiter_int;
1910
if (cur_val<0)or(cur_val>@'777777777) then
1911
begin print_err("Bad delimiter code");
1912
@.Bad delimiter code@>
1913
help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/
1914
("I changed this one to zero."); int_error(cur_val); cur_val:=0;
1922
if cur_val>biggest_char then
1926
@p procedure scan_dimen(@!mu,@!inf,@!shortcut:boolean);
1928
@p procedure xetex_scan_dimen(@!mu,@!inf,@!shortcut,@!requires_units:boolean);
1932
@<Scan units and set |cur_val| to $x\cdot(|cur_val|+f/2^{16})$, where there
1933
are |x| sp per unit; |goto attach_sign| if the units are internal@>;
1934
@<Scan an optional space@>;
1936
if requires_units then begin
1937
@<Scan units and set |cur_val| to $x\cdot(|cur_val|+f/2^{16})$, where there
1938
are |x| sp per unit; |goto attach_sign| if the units are internal@>;
1939
@<Scan an optional space@>;
1941
if cur_val>=@'40000 then arith_error:=true
1942
else cur_val:=cur_val*unity+f;
1947
@ @<Fetch an internal dimension and |goto attach_sign|...@>=
1949
procedure scan_dimen(@!mu,@!inf,@!shortcut:boolean);
1951
xetex_scan_dimen(mu,inf,shortcut,true);
1954
@ For XeTeX, we have an additional version |scan_decimal|, like |scan_dimen|
1955
but without any scanning of units.
1957
@p procedure scan_decimal;
1958
{sets |cur_val| to a quantity expressed as a decimal fraction}
1960
xetex_scan_dimen(false, false, false, false);
1963
@ @<Fetch an internal dimension and |goto attach_sign|...@>=
1967
@d etex_convert_base=5 {base for \eTeX's command codes}
1968
@d eTeX_revision_code=etex_convert_base {command code for \.{\\eTeXrevision}}
1969
@d etex_convert_codes=etex_convert_base+1 {end of \eTeX's command codes}
1971
@d etex_convert_base=5 {base for \eTeX's command codes}
1972
@d eTeX_revision_code=etex_convert_base {command code for \.{\\eTeXrevision}}
1974
@d XeTeX_revision_code=6
1975
@d XeTeX_variation_name_code=7 { must match codes in xetexmac.c }
1976
@d XeTeX_feature_name_code=8
1977
@d XeTeX_selector_name_code=9
1978
@d XeTeX_glyph_name_code=10
1980
@d etex_convert_codes=XeTeX_glyph_name_code+1 {end of \eTeX's command codes}
1984
eTeX_revision_code: print_esc("eTeXrevision");
1986
@/@<Cases of |convert| for |print_cmd_chr|@>@/
1990
@!c:number_code..job_name_code; {desired type of conversion}
1992
@!c:small_number; {desired type of conversion}
1996
@!b:pool_pointer; {base of temporary string}
1998
@!b:pool_pointer; {base of temporary string}
1999
@!fnt,@!arg1,@!arg2:integer; {args for \XeTeX\ extensions}
2000
@!font_name_str:str_number; {local vars for \.{\\fontname} quoting extension}
2002
@!quote_char:UTF16_code;
2006
eTeX_revision_code: do_nothing;
2008
@/@<Cases of `Scan the argument for command |c|'@>@/
2012
font_name_code: begin print(font_name[cur_val]);
2014
font_name_code: begin
2015
font_name_str:=font_name[cur_val];
2016
if is_native_font(cur_val) then begin
2018
for i:=0 to length(font_name_str) - 1 do
2019
if str_pool[str_start_macro(font_name_str) + i] = """" then quote_char:="'";
2020
print_char(quote_char);
2021
print(font_name_str);
2022
print_char(quote_char);
2024
print(font_name_str);
2028
eTeX_revision_code: print(eTeX_revision);
2030
@/@<Cases of `Print the result of command |c|'@>@/
2034
job_name_code: print(job_name);
2036
job_name_code: print_file_name(job_name, 0, 0);
2040
@!read_file:array[0..15] of alpha_file; {used for \.{\\read}}
2042
@!read_file:array[0..15] of unicode_file; {used for \.{\\read}}
2046
else begin a_close(read_file[m]); read_open[m]:=closed;
2048
else begin u_close(read_file[m]); read_open[m]:=closed;
2052
begin a_close(read_file[m]); read_open[m]:=closed;
2054
begin u_close(read_file[m]); read_open[m]:=closed;
2058
if (cur_cmd>active_char)or(cur_chr>255) then {not a character}
2059
begin m:=relax; n:=256;
2061
if (cur_cmd>active_char)or(cur_chr>biggest_char) then {not a character}
2062
begin m:=relax; n:=too_big_char;
2066
if (cur_cmd>active_char)or(cur_chr>255) then
2067
begin cur_cmd:=relax; cur_chr:=256;
2069
if (cur_cmd>active_char)or(cur_chr>biggest_char) then
2070
begin cur_cmd:=relax; cur_chr:=too_big_char;
2074
@* \[29] File names.
2076
@* \[29] File names.
2080
The following procedures don't allow spaces to be part of
2081
file names; but some users seem to like names that are spaced-out.
2082
System-dependent changes to allow such things should probably
2083
be made with reluctance, and only when an entire file name that
2084
includes spaces is ``quoted'' somehow.
2090
@!ext_delimiter:pool_pointer; {the most recent `\..', if any}
2092
@!ext_delimiter:pool_pointer; {the most recent `\..', if any}
2093
@!file_name_quote_char:UTF16_code;
2097
begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false;
2099
begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false;
2100
file_name_quote_char:=0;
2104
@p function more_name(@!c:ASCII_code):boolean;
2105
begin if (c=" ") and stop_at_space and (not quoted_filename) then
2107
else if c="""" then begin
2108
quoted_filename:=not quoted_filename;
2112
@p function more_name(@!c:ASCII_code):boolean;
2113
begin if stop_at_space and (c=" ") and (file_name_quote_char=0) then
2115
else if stop_at_space and (file_name_quote_char<>0) and (c=file_name_quote_char) then begin
2116
file_name_quote_char:=0;
2119
else if stop_at_space and (file_name_quote_char=0) and ((c="""") or (c="'") or (c="(")) then begin
2120
if c="(" then file_name_quote_char:=")"
2121
else file_name_quote_char:=c;
2122
quoted_filename:=true;
2128
@p procedure end_name;
2129
var temp_str: str_number; {result of file name cache lookups}
2130
@!j,@!s,@!t: pool_pointer; {running indices}
2131
@!must_quote:boolean; {whether we need to quote a string}
2132
begin if str_ptr+3>max_strings then
2133
overflow("number of strings",max_strings-init_str_ptr);
2134
@:TeX capacity exceeded number of strings}{\quad number of strings@>
2135
str_room(6); {Room for quotes, if needed.}
2136
{add quotes if needed}
2137
if area_delimiter<>0 then begin
2138
{maybe quote |cur_area|}
2140
s:=str_start[str_ptr];
2141
t:=str_start[str_ptr]+area_delimiter;
2143
while (not must_quote) and (j<>t) do begin
2144
must_quote:=str_pool[j]=" "; incr(j);
2146
if must_quote then begin
2147
for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
2148
str_pool[t+1]:="""";
2149
for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
2151
if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2;
2152
area_delimiter:=area_delimiter+2;
2153
pool_ptr:=pool_ptr+2;
2156
{maybe quote |cur_name|}
2157
s:=str_start[str_ptr]+area_delimiter;
2158
if ext_delimiter=0 then t:=pool_ptr else t:=str_start[str_ptr]+ext_delimiter-1;
2161
while (not must_quote) and (j<>t) do begin
2162
must_quote:=str_pool[j]=" "; incr(j);
2164
if must_quote then begin
2165
for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
2166
str_pool[t+1]:="""";
2167
for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
2169
if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2;
2170
pool_ptr:=pool_ptr+2;
2172
if ext_delimiter<>0 then begin
2173
{maybe quote |cur_ext|}
2174
s:=str_start[str_ptr]+ext_delimiter-1;
2178
while (not must_quote) and (j<>t) do begin
2179
must_quote:=str_pool[j]=" "; incr(j);
2181
if must_quote then begin
2182
str_pool[t+1]:="""";
2183
for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
2185
pool_ptr:=pool_ptr+2;
2189
@p procedure end_name;
2190
var temp_str: str_number; {result of file name cache lookups}
2191
@!j: pool_pointer; {running index}
2192
begin if str_ptr+3>max_strings then
2193
overflow("number of strings",max_strings-init_str_ptr);
2194
@:TeX capacity exceeded number of strings}{\quad number of strings@>
2198
str_start[str_ptr+1]:=str_start[str_ptr]+area_delimiter; incr(str_ptr);
2200
str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+area_delimiter; incr(str_ptr);
2204
for j:=str_start[str_ptr+1] to pool_ptr-1 do
2206
for j:=str_start_macro(str_ptr+1) to pool_ptr-1 do
2210
str_start[str_ptr+1]:=str_start[str_ptr]+ext_delimiter-area_delimiter-1;
2212
str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+ext_delimiter-area_delimiter-1;
2216
for j:=str_start[str_ptr+1] to pool_ptr-1 do
2218
for j:=str_start_macro(str_ptr+1) to pool_ptr-1 do
2222
procedure print_file_name(@!n,@!a,@!e:integer);
2223
var must_quote: boolean; {whether to quote the filename}
2224
@!j:pool_pointer; {index into |str_pool|}
2229
while (not must_quote) and (j<>str_start[a+1]) do begin
2230
must_quote:=str_pool[j]=" "; incr(j);
2235
while (not must_quote) and (j<>str_start[n+1]) do begin
2236
must_quote:=str_pool[j]=" "; incr(j);
2241
while (not must_quote) and (j<>str_start[e+1]) do begin
2242
must_quote:=str_pool[j]=" "; incr(j);
2245
{FIXME: Alternative is to assume that any filename that has to be quoted has
2246
at least one quoted component...if we pick this, a number of insertions
2247
of |print_file_name| should go away.
2248
|must_quote|:=((|a|<>0)and(|str_pool|[|str_start|[|a|]]=""""))or
2249
((|n|<>0)and(|str_pool|[|str_start|[|n|]]=""""))or
2250
((|e|<>0)and(|str_pool|[|str_start|[|e|]]=""""));}
2251
if must_quote then print_char("""");
2253
for j:=str_start[a] to str_start[a+1]-1 do
2254
if so(str_pool[j])<>"""" then
2255
print(so(str_pool[j]));
2257
for j:=str_start[n] to str_start[n+1]-1 do
2258
if so(str_pool[j])<>"""" then
2259
print(so(str_pool[j]));
2261
for j:=str_start[e] to str_start[e+1]-1 do
2262
if so(str_pool[j])<>"""" then
2263
print(so(str_pool[j]));
2264
if must_quote then print_char("""");
2267
procedure print_file_name(@!n,@!a,@!e:integer);
2268
var @!must_quote: boolean; {whether to quote the filename}
2269
@!quote_char: integer; {current quote char (single or double)}
2270
@!j:pool_pointer; {index into |str_pool|}
2275
j:=str_start_macro(a);
2276
while ((not must_quote) or (quote_char=0)) and (j<>str_start_macro(a+1)) do begin
2277
if (str_pool[j]=" ") then must_quote:=true
2278
else if (str_pool[j]="""") or (str_pool[j]="'") then begin
2280
quote_char:="""" + "'" - str_pool[j];
2286
j:=str_start_macro(n);
2287
while ((not must_quote) or (quote_char=0)) and (j<>str_start_macro(n+1)) do begin
2288
if (str_pool[j]=" ") then must_quote:=true
2289
else if (str_pool[j]="""") or (str_pool[j]="'") then begin
2291
quote_char:="""" + "'" - str_pool[j];
2297
j:=str_start_macro(e);
2298
while ((not must_quote) or (quote_char=0)) and (j<>str_start_macro(e+1)) do begin
2299
if (str_pool[j]=" ") then must_quote:=true
2300
else if (str_pool[j]="""") or (str_pool[j]="'") then begin
2302
quote_char:="""" + "'" - str_pool[j];
2307
if must_quote then begin
2308
if quote_char=0 then quote_char:="""";
2309
print_char(quote_char);
2312
for j:=str_start_macro(a) to str_start_macro(a+1)-1 do begin
2313
if str_pool[j]=quote_char then begin
2315
quote_char:="""" + "'" - quote_char;
2321
for j:=str_start_macro(n) to str_start_macro(n+1)-1 do begin
2322
if str_pool[j]=quote_char then begin
2324
quote_char:="""" + "'" - quote_char;
2330
for j:=str_start_macro(e) to str_start_macro(e+1)-1 do begin
2331
if str_pool[j]=quote_char then begin
2333
quote_char:="""" + "'" - quote_char;
2338
if quote_char<>0 then print_char(quote_char);
2343
@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
2344
if k<=file_name_size then name_of_file[k]:=xchr[c];
2347
@d append_to_name(#)==begin c:=#; incr(k);
2348
if k<=file_name_size then begin
2349
if (c < 128) then name_of_file[k]:=c
2350
else if (c < @"800) then begin
2351
name_of_file[k]:=@"C0 + c div @"40; incr(k);
2352
name_of_file[k]:=@"80 + c mod @"40;
2354
name_of_file[k]:=@"E0 + c div @"1000; incr(k);
2355
name_of_file[k]:=@"80 + (c mod @"1000) div @"40; incr(k);
2356
name_of_file[k]:=@"80 + (c mod @"1000) mod @"40;
2363
name_of_file:= xmalloc_array (ASCII_code, length(a)+length(n)+length(e)+1);
2364
for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j]));
2365
for j:=str_start[n] to str_start[n+1]-1 do append_to_name(so(str_pool[j]));
2366
for j:=str_start[e] to str_start[e+1]-1 do append_to_name(so(str_pool[j]));
2368
name_of_file:= xmalloc_array (UTF8_code, (length(a)+length(n)+length(e))*3+1);
2369
for j:=str_start_macro(a) to str_start_macro(a+1)-1 do append_to_name(so(str_pool[j]));
2370
for j:=str_start_macro(n) to str_start_macro(n+1)-1 do append_to_name(so(str_pool[j]));
2371
for j:=str_start_macro(e) to str_start_macro(e+1)-1 do append_to_name(so(str_pool[j]));
2375
name_of_file := xmalloc_array (ASCII_code, n+(b-a+1)+format_ext_length+1);
2376
for j:=1 to n do append_to_name(xord[TEX_format_default[j]]);
2378
name_of_file := xmalloc_array (UTF8_code, n+(b-a+1)+format_ext_length+1);
2379
for j:=1 to n do append_to_name(TEX_format_default[j]);
2383
append_to_name(xord[TEX_format_default[j]]);
2385
append_to_name(TEX_format_default[j]);
2389
@p function make_name_string:str_number;
2390
var k:1..file_name_size; {index into |name_of_file|}
2391
begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or
2393
make_name_string:="?"
2394
else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]);
2395
make_name_string:=make_string;
2397
{At this point we also set |cur_name|, |cur_ext|, and |cur_area| to
2398
match the contents of |name_of_file|.}
2400
name_in_progress:=true;
2402
stop_at_space:=false;
2403
while (k<=name_length)and(more_name(name_of_file[k])) do
2405
stop_at_space:=true;
2407
name_in_progress:=false;
2410
@p function make_name_string:str_number;
2411
var k:1..file_name_size; {index into |name_of_file|}
2412
begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or
2414
make_name_string:="?"
2417
for k:=0 to name_length16-1 do append_char(name_of_file16[k]);
2418
make_name_string:=make_string;
2421
function u_make_name_string(var f:unicode_file):str_number;
2422
begin u_make_name_string:=make_name_string;
2427
loop@+begin if (cur_cmd>other_char)or(cur_chr>255) then {not a character}
2429
loop@+begin if (cur_cmd>other_char)or(cur_chr>biggest_char) then
2434
{If |cur_chr| is a space and we're not scanning a token list, check
2435
whether we're at the end of the buffer. Otherwise we end up adding
2436
spurious spaces to file names in some cases.}
2437
if (cur_chr=" ") and (state<>token_list) and (loc>limit) then goto done;
2442
pack_job_name(".dvi");
2443
while not b_open_out(dvi_file) do
2444
prompt_file_name("file name for output",".dvi");
2446
pack_job_name(output_file_extension);
2447
while not dvi_open_out(dvi_file) do
2448
prompt_file_name("file name for output",output_file_extension);
2452
@!dvi_file: byte_file; {the device-independent output goes here}
2454
@!output_file_extension: str_number;
2455
@!no_pdf_output: boolean;
2456
@!dvi_file: byte_file; {the device-independent output goes here}
2460
@ @<Initialize the output...@>=output_file_name:=0;
2462
@ @<Initialize the output...@>=
2463
output_file_name:=0;
2464
if no_pdf_output then output_file_extension:=".xdv"
2465
else output_file_extension:=".pdf";
2469
if open_in_name_ok(stringcast(name_of_file+1))
2470
and a_open_in(cur_file, kpse_tex_format) then
2473
if open_in_name_ok(stringcast(name_of_file+1))
2474
and u_open_in(cur_file, kpse_tex_format, XeTeX_default_input_mode, XeTeX_default_input_encoding) then
2475
{At this point |name_of_file| contains the actual name found, as a UTF8 string.
2476
We convert to UTF16, then extract the |cur_area|, |cur_name|, and |cur_ext| from it.}
2479
name_in_progress:=true;
2481
stop_at_space:=false;
2483
while (k<name_length16)and(more_name(name_of_file16[k])) do
2485
stop_at_space:=true;
2487
name_in_progress:=false;
2493
@* \[30] Font metric data.
2495
@* \[30] Font metric data.
2499
@d non_char==qi(256) {a |halfword| code that can't match a real character}
2501
@d ot_font_flag=65534
2502
@d aat_font_flag=65535
2503
@d is_atsu_font(#)==(font_area[#]=aat_font_flag)
2504
@d is_ot_font(#)==(font_area[#]=ot_font_flag)
2505
@d is_native_font(#)==(is_atsu_font(#) or is_ot_font(#))
2506
{native fonts have font_area = 65534 or 65535,
2507
which would be a string containing an invalid Unicode character}
2509
@d non_char==qi(too_big_char) {a |halfword| code that can't match a real character}
2513
@!font_bc: ^eight_bits;
2514
{beginning (smallest) character code}
2515
@!font_ec: ^eight_bits;
2516
{ending (largest) character code}
2518
@!font_bc: ^UTF16_code;
2519
{beginning (smallest) character code}
2520
@!font_ec: ^UTF16_code;
2521
{ending (largest) character code}
2525
@!font_false_bchar: ^nine_bits;
2526
{|font_bchar| if it doesn't exist in the font, otherwise |non_char|}
2528
@!font_false_bchar: ^nine_bits;
2529
{|font_bchar| if it doesn't exist in the font, otherwise |non_char|}
2531
@!font_layout_engine: ^void_pointer; { either an ATSUStyle or a XeTeXLayoutEngine }
2532
@!font_mapping: ^void_pointer; { TECkit_Converter or 0 }
2533
@!font_flags: ^char; { flags:
2535
0x02: font_vertical }
2536
@!font_letter_space: ^scaled; { letterspacing to be applied to the font }
2537
@!loaded_font_mapping: void_pointer; { used by load_native_font to return mapping, if any }
2538
@!loaded_font_flags: char; { used by load_native_font to return flags }
2539
@!loaded_font_letter_space: scaled;
2540
@!mapped_text: ^UTF16_code; { scratch buffer used while applying font mappings }
2541
@!xdv_buffer: ^char; { scratch buffer used in generating XDV output }
2545
@<Read and check the font data; |abort| if the \.{TFM} file is
2548
pack_file_name(nom,aire,cur_ext);
2549
if quoted_filename then begin
2550
{ quoted name, so try for a native font }
2551
g:=load_native_font(u,nom,aire,s);
2552
if g=null_font then goto bad_tfm else goto done;
2554
{ it was an unquoted name, so try for a TFM file }
2555
@<Read and check the font data if file exists;
2556
|abort| if the \.{TFM} file is
2560
bad_tfm: @<Report that the font won't be loaded@>;
2562
if g<>null_font then goto done;
2563
if file_name_quote_char=0 then begin
2564
{ we failed to find a TFM file, so try for a native font }
2565
g:=load_native_font(u,nom,aire,s);
2566
if g<>null_font then goto done
2569
if (not file_opened) and (file_name_quote_char<>0) then begin
2570
@<Report that native font couldn't be found, and |goto done|@>;
2572
@<Report that the font won't be loaded@>;
2576
@d start_font_error_message==print_err("Font "); sprint_cs(u);
2577
print_char("="); print_file_name(nom,aire,"");
2579
@d start_font_error_message==print_err("Font "); sprint_cs(u);
2581
if file_name_quote_char=")" then print_char("(")
2582
else if file_name_quote_char<>0 then print_char(file_name_quote_char);
2583
print_file_name(nom,aire,cur_ext);
2584
if file_name_quote_char<>0 then print_char(file_name_quote_char);
2588
else print(" not loadable: Metric (TFM) file not found");
2590
else print(" not loadable: Metric (TFM) file or installed font not found");
2594
@ @<Read and check...@>=
2595
@<Open |tfm_file| for input@>;
2597
@ @<Report that native font couldn't be found, and |goto done|@>=
2598
start_font_error_message;
2599
@.Font x=xx not loadable...@>
2600
print(" not loadable: installed font not found");
2601
help4("I wasn't able to find this font in the Mac OS,")@/
2602
("so I will ignore the font specification.")@/
2603
("You might try inserting a different font spec;")@/
2604
("e.g., type `I\font<same font id>=<substitute font name>'.");
2608
@ @<Read and check...@>=
2609
@<Open |tfm_file| for input and |begin|@>;
2613
@<Make final adjustments and |goto done|@>
2615
@<Make final adjustments and |goto done|@>;
2620
@ @<Open |tfm_file| for input@>=
2623
@ @<Open |tfm_file| for input...@>=
2627
if not b_open_in(tfm_file) then abort;
2630
if b_open_in(tfm_file) then begin
2634
@x we have to move this before new_native_character
2635
@ When \TeX\ wants to typeset a character that doesn't exist, the
2636
character node is not created; thus the output routine can assume
2637
that characters exist when it sees them. The following procedure
2638
prints a warning message unless the user has suppressed it.
2640
@p procedure char_warning(@!f:internal_font_number;@!c:eight_bits);
2641
var old_setting: integer; {saved value of |tracing_online|}
2642
begin if tracing_lost_chars>0 then
2643
begin old_setting:=tracing_online;
2644
if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
2645
begin begin_diagnostic;
2646
print_nl("Missing character: There is no ");
2647
@.Missing character@>
2648
print_ASCII(c); print(" in font ");
2649
slow_print(font_name[f]); print_char("!"); end_diagnostic(false);
2651
tracing_online:=old_setting;
2655
@ Procedure |char_warning| has been moved in the source.
2659
@p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer;
2661
@p function new_character(@!f:internal_font_number;@!c:ASCII_code):pointer;
2665
begin ec:=effective_char(false,f,qi(c));
2668
if is_native_font(f) then
2669
begin new_character:=new_native_character(f,c); return;
2671
ec:=effective_char(false,f,qi(c));
2675
@* \[31] Device-independent file format.
2677
@* \[31] Device-independent file format.
2681
\yskip\noindent Commands 250--255 are undefined at the present time.
2683
\yskip\hang|set_glyph_string| 254 w[4] k[2] x[4k] g[2k].
2685
\yskip\hang|set_glyph_array| 253 w[4] k[2] xy[8k] g[2k]
2687
\yskip\hang|define_native_font| 252 k[4] s[4] flags[2]
2688
lenps[1] lenfam[1] lensty[1] ps[lenps] fam[lenfam] sty[lensty]
2689
if (flags & COLORED):
2691
if (flags & VARIATIONS):
2695
if (flags & MATRIX):
2696
ta[4] tb[4] tc[4] td[4] tx[4] ty[4]
2698
\yskip\hang|pic_file| 251 flags[1] t[4][6] p[2] len[2] path[l]
2699
flags = 0 for raster image, 1 for PDF
2700
t is transform matrix
2701
p is page # from the graphic file (0-based)
2702
len is length of pathname
2703
path is pathname of graphic file
2705
\yskip\noindent Commands 250 and 255 are undefined at the present time (but 255 is used by pTeX).
2709
@d post_post=249 {postamble ending}
2711
@d post_post=249 {postamble ending}
2713
@d set_glyph_string=254 {sequence of glyphs, all at the current y-position}
2714
@d set_glyph_array=253 {sequence of glyphs with individual x-y coordinates}
2715
@d define_native_font=252 {define native font}
2716
@d pic_file=251 {embed picture or PDF}
2720
@d id_byte=2 {identifies the kind of \.{DVI} files described here}
2722
XeTeX changes the DVI version to 5,
2723
as we have new DVI opcodes like |set_glyph_array| for native font text;
2724
I used version 3 in an earlier extension of TeX,
2725
and 4 in pre-1.0 XeTeX releases using Mac OS-specific data types.
2727
@d id_byte=5 {identifies the kind of \.{DVI} files described here}
2731
@* \[32] Shipping pages out.
2733
@* \[32] Shipping pages out.
2737
@ A mild optimization of the output is performed by the |dvi_pop|
2739
procedure dvi_two(s: UTF16_code);
2741
dvi_out(s div @'400);
2742
dvi_out(s mod @'400);
2745
@ A mild optimization of the output is performed by the |dvi_pop|
2749
@p procedure dvi_font_def(@!f:internal_font_number);
2751
@p procedure dvi_native_font_def(@!f:internal_font_number);
2753
font_def_length, i: integer;
2755
dvi_out(define_native_font);
2756
dvi_four(f-font_base-1);
2757
font_def_length := make_font_def(f);
2758
for i := 0 to font_def_length - 1 do dvi_out(xdv_buffer[i]);
2761
procedure dvi_font_def(@!f:internal_font_number);
2765
begin if f<=256+font_base then
2767
begin if is_native_font(f) then dvi_native_font_def(f) else
2768
begin if f<=256+font_base then
2772
@<Output the font name whose internal number is |f|@>;
2774
@<Output the font name whose internal number is |f|@>;
2779
@ @<Output the font name whose internal number is |f|@>=
2780
for k:=str_start[font_area[f]] to str_start[font_area[f]+1]-1 do
2781
dvi_out(so(str_pool[k]));
2782
for k:=str_start[font_name[f]] to str_start[font_name[f]+1]-1 do
2783
dvi_out(so(str_pool[k]))
2785
@ @<Output the font name whose internal number is |f|@>=
2786
for k:=str_start_macro(font_area[f]) to str_start_macro(font_area[f]+1)-1 do
2787
dvi_out(so(str_pool[k]));
2788
for k:=str_start_macro(font_name[f]) to str_start_macro(font_name[f]+1)-1 do
2789
dvi_out(so(str_pool[k]))
2793
@ @<Initialize variables as |ship_out| begins@>=
2794
dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font;
2796
@ @<Initialize variables as |ship_out| begins@>=
2797
dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font;
2798
@<Calculate page dimensions and margins@>;
2802
print(" TeX output "); print_int(year); print_char(".");
2804
print(" XeTeX output "); print_int(year); print_char(".");
2808
for s:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[s]));
2809
pool_ptr:=str_start[str_ptr]; {flush the current string}
2811
for s:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s]));
2812
pool_ptr:=str_start_macro(str_ptr); {flush the current string}
2816
@d next_p=15 {go to this label when finished with node |p|}
2818
@d next_p=15 {go to this label when finished with node |p|}
2821
@d end_node_run=1237
2825
label reswitch, move_past, fin_rule, next_p, continue, found;
2827
label reswitch, move_past, fin_rule, next_p, continue, found, check_next, end_node_run;
2831
@!prev_p:pointer; {one step behind |p|}
2833
@!prev_p:pointer; {one step behind |p|}
2834
@!len: integer; { length of scratch string for native word output }
2840
g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
2842
g_sign:=glue_sign(this_box);
2843
@<Merge sequences of words using AAT fonts and inter-word spaces into single nodes@>;
2844
p:=list_ptr(this_box);
2848
@ We ought to give special care to the efficiency of one part of |hlist_out|,
2850
@ Extra stuff for justifiable AAT text; need to merge runs of words and normal spaces.
2852
@d is_native_word_node(#) == (not is_char_node(#)) and (type(#) = whatsit_node) and (subtype(#) = native_word_node)
2854
@<Merge sequences of words using AAT fonts and inter-word spaces into single nodes@>=
2855
p := list_ptr(this_box);
2856
prev_p := this_box+list_offset;
2857
while p<>null do begin
2858
if link(p) <> null then begin {not worth looking ahead at the end}
2859
if is_native_word_node(p) and (font_area[native_font(p)] = aat_font_flag)
2860
and (font_letter_space[native_font(p)] = 0) then begin
2861
{got a word in an AAT font, might be the start of a run}
2862
r := p; {|r| is start of possible run}
2863
k := native_length(r);
2866
@<Advance |q| past ignorable nodes@>;
2867
if (q <> null) and not is_char_node(q) then begin
2868
if (type(q) = glue_node) and (subtype(q) = normal) and (glue_ptr(q) = font_glue[native_font(r)]) then begin
2869
{found a normal space; if the next node is another word in the same font, we'll merge}
2871
@<Advance |q| past ignorable nodes@>;
2872
if (q <> null) and is_native_word_node(q) and (native_font(q) = native_font(r)) then begin
2873
p := q; {record new tail of run in |p|}
2874
k := k + 1 + native_length(q);
2880
{@<Advance |q| past ignorable nodes@>;}
2881
if (q <> null) and is_native_word_node(q) and (native_font(q) = native_font(r)) then begin
2882
p := q; {record new tail of run in |p|}
2887
end_node_run: {now |r| points to first |native_word_node| of the run, and |p| to the last}
2888
if p <> r then begin {merge nodes from |r| to |p| inclusive; total text length is |k|}
2890
k := 0; {now we'll use this as accumulator for total width}
2893
if type(q) = whatsit_node then begin
2894
if subtype(q) = native_word_node then begin
2895
for j := 0 to native_length(q)-1 do
2896
append_char(get_native_char(q, j));
2899
end else if type(q) = glue_node then begin
2903
if g_sign <> normal then begin
2904
if g_sign = stretching then begin
2905
if stretch_order(g) = g_order then begin
2906
k := k + round(float(glue_set(this_box)) * stretch(g))
2909
if shrink_order(g) = g_order then begin
2910
k := k - round(float(glue_set(this_box)) * shrink(g))
2915
{discretionary and deleted nodes can be discarded here}
2920
q := new_native_word_node(native_font(r), cur_length);
2922
for j := 0 to cur_length - 1 do
2923
set_native_char(q, j, str_pool[str_start_macro(str_ptr) + j]);
2928
set_justified_native_glyphs(q);
2930
pool_ptr := str_start_macro(str_ptr); {flush the temporary string data}
2938
@ @<Advance |q| past ignorable nodes@>=
2939
while (q <> null) and (not is_char_node(q))
2940
and ( (type(q) = disc_node) or ((type(q) = whatsit_node) and (subtype(q) = deleted_native_node)) ) do
2943
@ We ought to give special care to the efficiency of one part of |hlist_out|,
2947
dvi_four(last_bop); last_bop:=page_loc;
2949
dvi_four(last_bop); last_bop:=page_loc;
2950
if (pdf_page_width > 0) and (pdf_page_height > 0) then begin
2951
{ generate a papersize \special at start of page }
2952
old_setting:=selector; selector:=new_string;
2953
print("papersize ");
2954
if mag=1000 then print_scaled(pdf_page_width)
2955
else print_scaled(xn_over_d(pdf_page_width,mag,1000));
2956
print("pt"); print(",");
2957
if mag=1000 then print_scaled(pdf_page_height)
2958
else print_scaled(xn_over_d(pdf_page_height,mag,1000));
2960
selector:=old_setting;
2961
dvi_out(xxx1); dvi_out(cur_length);
2962
for s:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s]));
2963
pool_ptr:=str_start_macro(str_ptr); {erase the string}
2968
dvi_out(eop); incr(total_pages); cur_s:=-1;
2970
dvi_out(eop); incr(total_pages); cur_s:=-1;
2971
if not no_pdf_output then fflush(dvi_file);
2975
print_nl("Output written on "); print_file_name(0, output_file_name, 0);
2977
print_nl("Output written on "); print(output_file_name);
2981
print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes).");
2984
if no_pdf_output then begin
2985
print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes).");
2986
end else print(").");
2987
dvi_close(dvi_file);
2997
@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
2998
label reswitch, common_ending, exit;
3000
@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
3001
label reswitch, common_ending, exit, restart;
3005
@!hd:eight_bits; {height and depth indices for a character}
3007
@!hd:eight_bits; {height and depth indices for a character}
3008
@!pp,@!ppp: pointer;
3009
@!total_chars, @!k: integer;
3013
@* \[34] Data structures for math mode.
3015
@* \[34] Data structures for math mode.
3019
@d fam==font {a |quarterword| in |mem|}
3021
@d plane_and_fam_field==font {a |quarterword| in |mem|}
3022
@d fam(#) == (plane_and_fam_field(#) mod @"100)
3026
@d small_fam(#)==mem[#].qqqq.b0 {|fam| for ``small'' delimiter}
3027
@d small_char(#)==mem[#].qqqq.b1 {|character| for ``small'' delimiter}
3028
@d large_fam(#)==mem[#].qqqq.b2 {|fam| for ``large'' delimiter}
3029
@d large_char(#)==mem[#].qqqq.b3 {|character| for ``large'' delimiter}
3031
@d small_fam(#)==(mem[#].qqqq.b0 mod @"100) {|fam| for ``small'' delimiter}
3032
@d small_char(#)==(mem[#].qqqq.b1 + (mem[#].qqqq.b0 div @"100) * @"10000) {|character| for ``small'' delimiter}
3033
@d large_fam(#)==(mem[#].qqqq.b2 mod @"100) {|fam| for ``large'' delimiter}
3034
@d large_char(#)==(mem[#].qqqq.b3 + (mem[#].qqqq.b2 div @"100) * @"10000) {|character| for ``large'' delimiter}
3035
@d small_plane_and_fam_field(#)==mem[#].qqqq.b0
3036
@d small_char_field(#)==mem[#].qqqq.b1
3037
@d large_plane_and_fam_field(#)==mem[#].qqqq.b2
3038
@d large_char_field(#)==mem[#].qqqq.b3
3042
procedure print_fam_and_char(@!p:pointer); {prints family and character}
3043
begin print_esc("fam"); print_int(fam(p)); print_char(" ");
3044
print_ASCII(qo(character(p)));
3046
procedure print_fam_and_char(@!p:pointer); {prints family and character}
3047
begin print_esc("fam"); print_int(fam(p) mod @"100); print_char(" ");
3048
print_ASCII(qo(character(p)) + (fam(p) div @"100) * @"10000);
3052
@* \[35] Subroutines for math mode.
3054
@* \[35] Subroutines for math mode.
3058
@d text_size=0 {size code for the largest size in a family}
3059
@d script_size=16 {size code for the medium size in a family}
3060
@d script_script_size=32 {size code for the smallest size in a family}
3065
else cur_size:=16*((cur_style-text_style) div 2);
3067
else cur_size:=script_size*((cur_style-text_style) div 2);
3071
function var_delimiter(@!d:pointer;@!s:small_number;@!v:scaled):pointer;
3073
function var_delimiter(@!d:pointer;@!s:integer;@!v:scaled):pointer;
3077
@!z: small_number; {runs through font family members}
3079
@!z: integer; {runs through font family members}
3084
repeat z:=z-16; g:=fam_fnt(z);
3086
begin z:=z+s+script_size;
3087
repeat z:=z-script_size; g:=fam_fnt(z);
3093
until z<script_size;
3097
function char_box(@!f:internal_font_number;@!c:quarterword):pointer;
3098
var q:four_quarters;
3099
@!hd:eight_bits; {|height_depth| byte}
3100
@!b,@!p:pointer; {the new box and its character node}
3101
begin q:=char_info(f)(c); hd:=height_depth(q);
3102
b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q);
3103
height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd);
3104
p:=get_avail; character(p):=c; font(p):=f; list_ptr(b):=p; char_box:=b;
3107
function char_box(@!f:internal_font_number;@!c:integer):pointer;
3108
var q:four_quarters;
3109
@!hd:eight_bits; {|height_depth| byte}
3110
@!b,@!p:pointer; {the new box and its character node}
3112
if is_native_font(f) then begin
3114
p:=new_native_character(f, c);
3116
height(b):=height(p); width(b):=width(p);
3117
if depth(p)<0 then depth(b):=0 else depth(b):=depth(p);
3120
q:=char_info(f)(c); hd:=height_depth(q);
3121
b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q);
3122
height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd);
3123
p:=get_avail; character(p):=c; font(p):=f;
3125
list_ptr(b):=p; char_box:=b;
3130
@* \[36] Typesetting math formulas.
3132
@* \[36] Typesetting math formulas.
3136
@!cur_size:small_number; {size code corresponding to |cur_style|}
3137
@y with 256 families, this can be up to 768
3138
@!cur_size:integer; {size code corresponding to |cur_style|}
3142
@p procedure fetch(@!a:pointer); {unpack the |math_char| field |a|}
3143
begin cur_c:=character(a); cur_f:=fam_fnt(fam(a)+cur_size);
3144
if cur_f=null_font then
3145
@<Complain about an undefined family and set |cur_i| null@>
3146
else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then
3147
cur_i:=orig_char_info(cur_f)(cur_c)
3149
@p procedure fetch(@!a:pointer); {unpack the |math_char| field |a|}
3150
begin cur_c:=cast_to_ushort(character(a)); cur_f:=fam_fnt(fam(a)+cur_size);
3151
cur_c:=cur_c + (plane_and_fam_field(a) div @"100) * @"10000;
3152
if cur_f=null_font then
3153
@<Complain about an undefined family and set |cur_i| null@>
3154
else if is_native_font(cur_f) then begin
3155
cur_i:=null_character;
3156
end else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then
3157
cur_i:=orig_char_info(cur_f)(cur_c)
3161
@!cur_c:quarterword; {the |character| field of a |math_char|}
3163
@!cur_c:integer; {the |character| field of a |math_char|}
3167
procedure make_math_accent(@!q:pointer);
3169
var p,@!x,@!y:pointer; {temporary registers for box construction}
3170
@!a:integer; {address of lig/kern instruction}
3171
@!c:quarterword; {accent character}
3172
@!f:internal_font_number; {its font}
3173
@!i:four_quarters; {its |char_info|}
3174
@!s:scaled; {amount to skew the accent to the right}
3175
@!h:scaled; {height of character being accented}
3176
@!delta:scaled; {space to remove between accent and accentee}
3177
@!w:scaled; {width of the accentee, not including sub/superscripts}
3178
begin fetch(accent_chr(q));
3179
if char_exists(cur_i) then
3180
begin i:=cur_i; c:=cur_c; f:=cur_f;@/
3181
@<Compute the amount of skew@>;
3182
x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x);
3183
@<Switch to a larger accent if available and appropriate@>;
3185
procedure make_math_accent(@!q:pointer);
3187
var p,@!x,@!y:pointer; {temporary registers for box construction}
3188
@!a:integer; {address of lig/kern instruction}
3189
@!c:integer; {accent character}
3190
@!f:internal_font_number; {its font}
3191
@!i:four_quarters; {its |char_info|}
3192
@!s:scaled; {amount to skew the accent to the right}
3193
@!h:scaled; {height of character being accented}
3194
@!delta:scaled; {space to remove between accent and accentee}
3195
@!w:scaled; {width of the accentee, not including sub/superscripts}
3196
begin fetch(accent_chr(q));
3198
if is_native_font(cur_f) then
3199
begin c:=cur_c; f:=cur_f;
3200
s:=0; {@<Compute the amount of skew@>;}
3201
x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x);
3203
else if char_exists(cur_i) then
3204
begin i:=cur_i; c:=cur_c; f:=cur_f;@/
3205
@<Compute the amount of skew@>;
3206
x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x);
3207
@<Switch to a larger accent if available and appropriate@>;
3209
if x<>null then begin
3213
character(nucleus(r)):=rem_byte(cur_i);
3214
fam(nucleus(r)):=fam(nucleus(q));@/
3216
character(nucleus(r)):=rem_byte(cur_i);
3217
plane_and_fam_field(nucleus(r)):=fam(nucleus(q));@/
3221
@ @<Create a character node |p| for |nucleus(q)|...@>=
3222
begin fetch(nucleus(q));
3223
if char_exists(cur_i) then
3225
@ @<Create a character node |p| for |nucleus(q)|...@>=
3226
begin fetch(nucleus(q));
3227
if is_native_font(cur_f) then begin
3228
delta:=0; p:=new_native_character(cur_f, qo(cur_c));
3229
end else if char_exists(cur_i) then
3233
procedure make_scripts(@!q:pointer;@!delta:scaled);
3234
var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
3235
@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
3236
@!t:small_number; {subsidiary size code}
3238
procedure make_scripts(@!q:pointer;@!delta:scaled);
3239
var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
3240
@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
3241
@!t:integer; {subsidiary size code}
3245
magic_offset:=str_start[math_spacing]-9*ord_noad
3247
magic_offset:=str_start_macro(math_spacing)-9*ord_noad
3257
@d span_code=256 {distinct from any character}
3258
@d cr_code=257 {distinct from |span_code| and from any character}
3260
@d span_code=special_char {distinct from any character}
3261
@d cr_code=span_code+1 {distinct from |span_code| and from any character}
3265
if n>max_quarterword then confusion("256 spans"); {this can happen, but won't}
3266
@^system dependencies@>
3267
@:this can't happen 256 spans}{\quad 256 spans@>
3269
if n>max_quarterword then confusion("too many spans");
3270
{this can happen, but won't}
3271
@^system dependencies@>
3272
@:this can't happen too many spans}{\quad too many spans@>
3276
@* \[38] Breaking paragraphs into lines.
3278
@* \[38] Breaking paragraphs into lines.
3282
label done,done1,done2,done3,done4,done5,continue;
3284
label done,done1,done2,done3,done4,done5,done6,continue, restart;
3288
othercases confusion("disc1")
3291
if (subtype(v)=native_word_node)
3292
or (subtype(v)=glyph_node)
3293
or (subtype(v)=pic_node)
3294
or (subtype(v)=pdf_node)
3295
then break_width[1]:=break_width[1]-width(v)
3296
else if subtype(v)=deleted_native_node then do_nothing
3297
else confusion("disc1a");
3298
othercases confusion("disc1")
3302
othercases confusion("disc2")
3305
if (subtype(s)=native_word_node)
3306
or (subtype(s)=glyph_node)
3307
or (subtype(s)=pic_node)
3308
or (subtype(s)=pdf_node)
3309
then break_width[1]:=break_width[1]+width(s)
3310
else if subtype(s)=deleted_native_node then do_nothing
3311
else confusion("disc2a");
3312
othercases confusion("disc2")
3316
@* \[39] Breaking paragraphs into lines, continued.
3318
@* \[39] Breaking paragraphs into lines, continued.
3322
othercases confusion("disc3")
3325
if (subtype(s)=native_word_node)
3326
or (subtype(s)=glyph_node)
3327
or (subtype(s)=pic_node)
3328
or (subtype(s)=pdf_node)
3329
then disc_width:=disc_width+width(s)
3330
else if subtype(s)=deleted_native_node then do_nothing
3331
else confusion("disc3a");
3332
othercases confusion("disc3")
3336
othercases confusion("disc4")
3339
if (subtype(s)=native_word_node)
3340
or (subtype(s)=glyph_node)
3341
or (subtype(s)=pic_node)
3342
or (subtype(s)=pdf_node)
3343
then act_width:=act_width+width(s)
3344
else if subtype(s)=deleted_native_node then do_nothing
3345
else confusion("disc4a");
3346
othercases confusion("disc4")
3350
@* \[40] Pre-hyphenation.
3352
@* \[40] Pre-hyphenation.
3356
@!hc:array[0..65] of 0..256; {word to be hyphenated}
3358
@!hc:array[0..65] of 0..too_big_char; {word to be hyphenated}
3362
@!hu:array[0..63] of 0..256; {like |hc|, before conversion to lowercase}
3364
@!hu:array[0..63] of 0..too_big_char;
3365
{like |hc|, before conversion to lowercase}
3369
@!cur_lang,@!init_cur_lang:ASCII_code; {current hyphenation table of interest}
3371
@!cur_lang,@!init_cur_lang:0..biggest_lang;
3372
{current hyphenation table of interest}
3376
@!hyf_bchar:halfword; {boundary character after $c_n$}
3378
@!hyf_bchar:halfword; {boundary character after $c_n$}
3379
@!max_hyph_char:integer;
3381
@ @<Set initial values of key variables@>=
3382
max_hyph_char:=too_big_lang;
3386
@!c:0..255; {character being considered for hyphenation}
3388
@!c:ASCII_code; {character being considered for hyphenation}
3392
@<Skip to node |hb|, putting letters into |hu| and |hc|@>;
3394
if (not is_char_node(ha)) and (type(ha) = whatsit_node) and (subtype(ha) = native_word_node) then begin
3395
@<Check that nodes after |native_word| permit hyphenation; if not, |goto done1|@>;
3396
@<Prepare a |native_word_node| for hyphenation@>;
3398
@<Skip to node |hb|, putting letters into |hu| and |hc|@>;
3403
@ The first thing we need to do is find the node |ha| just before the
3406
@ @<Check that nodes after |native_word| permit hyphenation; if not, |goto done1|@>=
3408
loop@+ begin if not(is_char_node(s)) then
3410
ligature_node: do_nothing;
3411
kern_node: if subtype(s)<>normal then goto done6;
3412
whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node:
3414
othercases goto done1
3420
@ @<Prepare a |native_word_node| for hyphenation@>=
3421
{ note that if there are chars with |lccode = 0|, we split them out into separate |native_word| nodes }
3424
for l := 0 to native_length(ha)-1 do begin
3425
c := get_native_char(ha, l);
3427
if (hc[0] = 0) {or (hc[0] > max_hyph_char) -- no, there can be letters > max_hyph_char in the word}
3429
if (hn > 0) then begin
3430
{ we've got some letters, and now found a non-letter, so break off the tail of the |native_word|
3431
and link it after this node, and goto done3 }
3432
@<Split the |native_word_node| at |l| and link the second part after |ha|@>;
3435
end else if (hn = 0) and (l > 0) then begin
3436
{ we've found the first letter after some non-letters, so break off the head of the |native_word| and restart }
3437
@<Split the |native_word_node| at |l| and link the second part after |ha|@>;
3440
end else if (hn = 63) then
3441
{ reached max hyphenatable length }
3444
{ found a letter that is part of a potentially hyphenatable sequence }
3445
incr(hn); hu[hn] := c; hc[hn] := hc[0]; hyf_bchar := non_char;
3449
@ @<Split the |native_word_node| at |l| and link the second part after |ha|@>=
3450
q := new_native_word_node(hf, native_length(ha) - l);
3451
for i := l to native_length(ha) - 1 do
3452
set_native_char(q, i - l, get_native_char(ha, i));
3453
set_native_metrics(q, XeTeX_use_glyph_metrics);
3454
link(q) := link(ha);
3456
{ truncate text in node |ha| }
3457
native_length(ha) := l;
3458
set_native_metrics(ha, XeTeX_use_glyph_metrics);
3460
@ @<Local variables for line breaking@>=
3464
@ The first thing we need to do is find the node |ha| just before the
3469
begin @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>;
3473
if subtype(s) = native_word_node then begin
3474
{ we only consider the node if it contains at least one letter, otherwise we'll skip it }
3475
for l:=0 to native_length(s) - 1 do begin
3476
c := get_native_char(s, l);
3477
if lc_code(c) <> 0 then begin
3478
hf := native_font(s);
3484
@<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>;
3489
if hyf_char>255 then goto done1;
3491
if hyf_char>biggest_char then goto done1;
3495
if hc[0]=0 then goto done3;
3497
if hc[0]=0 then goto done3;
3498
if hc[0]>max_hyph_char then goto done3;
3502
if hc[0]=0 then goto done3;
3504
if hc[0]=0 then goto done3;
3505
if hc[0]>max_hyph_char then goto done3;
3509
@* \[41] Post-hyphenation.
3511
@* \[41] Post-hyphenation.
3515
@<Replace nodes |ha..hb| by a sequence of nodes...@>=
3517
@<Replace nodes |ha..hb| by a sequence of nodes...@>=
3518
if (not is_char_node(ha)) and (type(ha) = whatsit_node) and (subtype(ha) = native_word_node) then begin
3519
@<Hyphenate the |native_word_node| at |ha|@>;
3524
begin hu[0]:=256; init_lig:=false;
3526
begin hu[0]:=max_hyph_char; init_lig:=false;
3530
found2: s:=ha; j:=0; hu[0]:=256; init_lig:=false; init_list:=null;
3532
found2: s:=ha; j:=0; hu[0]:=max_hyph_char; init_lig:=false; init_list:=null;
3536
flush_list(init_list)
3538
flush_list(init_list);
3541
@ @<Hyphenate the |native_word_node| at |ha|@>=
3542
{ find the node immediately before the word to be hyphenated }
3543
s := cur_p; {we have |cur_p<>ha| because |type(cur_p)=glue_node|}
3544
while link(s) <> ha do s := link(s);
3546
{ for each hyphen position,
3547
create a |native_word_node| fragment for the text before this point,
3548
and a |disc_node| for the break, with the |hyf_char| in the |pre_break| text
3551
hyphen_passed := 0; { location of last hyphen we saw }
3553
for j := l_hyf to hn - r_hyf do begin
3554
{ if this is a valid break.... }
3555
if odd(hyf[j]) then begin
3557
{ make a |native_word_node| for the fragment before the hyphen }
3558
q := new_native_word_node(hf, j - hyphen_passed);
3559
for i := 0 to j - hyphen_passed - 1 do
3560
set_native_char(q, i, get_native_char(ha, i + hyphen_passed));
3561
set_native_metrics(q, XeTeX_use_glyph_metrics);
3562
link(s) := q; { append the new node }
3565
{ make the |disc_node| for the hyphenation point }
3567
pre_break(q) := new_native_character(hf, hyf_char);
3575
{ make a |native_word_node| for the last fragment of the word }
3576
hn := native_length(ha); { ensure trailing punctuation is not lost! }
3577
q := new_native_word_node(hf, hn - hyphen_passed);
3578
for i := 0 to hn - hyphen_passed - 1 do
3579
set_native_char(q, i, get_native_char(ha, i + hyphen_passed));
3580
set_native_metrics(q, XeTeX_use_glyph_metrics);
3581
link(s) := q; { append the new node }
3587
flush_node_list(ha);
3591
begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=256;
3593
begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=max_hyph_char;
3597
@* \[42] Hyphenation.
3599
@* \[42] Hyphenation.
3603
@!op_start:array[ASCII_code] of 0..trie_op_size; {offset for current language}
3605
@!op_start:array[0..biggest_lang] of 0..trie_op_size; {offset for current language}
3609
hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=256; {insert delimiters}
3611
hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=max_hyph_char; {insert delimiters}
3615
begin j:=1; u:=str_start[k];
3617
begin j:=1; u:=str_start_macro(k);
3621
else if language>255 then cur_lang:=0
3623
else if language>biggest_lang then cur_lang:=0
3627
u:=str_start[k]; v:=str_start[s];
3629
u:=str_start_macro(k); v:=str_start_macro(s);
3633
until u=str_start[k+1];
3635
until u=str_start_macro(k+1);
3639
@* \[43] Initializing the hyphenation tables.
3641
@* \[43] Initializing the hyphenation tables.
3645
@!trie_used:array[ASCII_code] of trie_opcode;
3647
@!trie_used:array[0..biggest_lang] of trie_opcode;
3651
@!trie_op_lang:array[1..trie_op_size] of ASCII_code;
3653
@!trie_op_lang:array[1..trie_op_size] of 0..biggest_lang;
3657
for j:=1 to 255 do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
3659
for j:=1 to biggest_lang do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
3663
for k:=0 to 255 do trie_used[k]:=min_trie_op;
3665
for k:=0 to biggest_lang do trie_used[k]:=min_trie_op;
3669
for p:=0 to 255 do trie_min[p]:=p+1;
3671
for p:=0 to biggest_char do trie_min[p]:=p+1;
3675
@!ll:1..256; {upper limit of |trie_min| updating}
3677
@!ll:1..too_big_char; {upper limit of |trie_min| updating}
3681
@<Ensure that |trie_max>=h+256|@>;
3683
@<Ensure that |trie_max>=h+max_hyph_char|@>;
3687
@ By making sure that |trie_max| is at least |h+256|, we can be sure that
3689
@ By making sure that |trie_max| is at least |h+max_hyph_char|,
3694
@<Ensure that |trie_max>=h+256|@>=
3695
if trie_max<h+256 then
3696
begin if trie_size<=h+256 then overflow("pattern memory",trie_size);
3698
@<Ensure that |trie_max>=h+max_hyph_char|@>=
3699
if trie_max<h+max_hyph_char then
3700
begin if trie_size<=h+max_hyph_char then overflow("pattern memory",trie_size);
3704
until trie_max=h+256;
3706
until trie_max=h+max_hyph_char;
3711
begin if z<256 then ll:=z @+else ll:=256;
3713
if l<max_hyph_char then
3714
begin if z<max_hyph_char then ll:=z @+else ll:=max_hyph_char;
3718
begin for r:=0 to 256 do clear_trie;
3721
begin for r:=0 to max_hyph_char do clear_trie;
3722
trie_max:=max_hyph_char;
3728
if cur_chr>max_hyph_char then max_hyph_char:=cur_chr;
3733
begin @<Get ready to compress the trie@>;
3736
incr(max_hyph_char);
3737
@<Get ready to compress the trie@>;
3741
@* \[44] Breaking vertical lists into pages.
3743
@* \[44] Breaking vertical lists into pages.
3747
@* \[45] The page builder.
3749
@* \[45] The page builder.
3753
@!n:min_quarterword..255; {insertion box number}
3755
@!n:min_quarterword..biggest_reg; {insertion box number}
3759
@!n:min_quarterword..255; {insertion box number}
3761
@!n:min_quarterword..biggest_reg; {insertion box number}
3765
@* \[46] The chief executive.
3767
@* \[46] The chief executive.
3771
@d main_loop=70 {go here to typeset a string of consecutive characters}
3773
@d main_loop=70 {go here to typeset a string of consecutive characters}
3774
@d collect_native=71 {go here to collect characters in a "native" font string}
3778
hmode+char_num: begin scan_char_num; cur_chr:=cur_val; goto main_loop;@+end;
3780
hmode+char_num: begin scan_usv_num; cur_chr:=cur_val; goto main_loop;@+end;
3784
@!main_p:pointer; {temporary register for list manipulation}
3786
@!main_p:pointer; {temporary register for list manipulation}
3787
@!main_pp:pointer; {another temporary register for list manipulation}
3788
@!main_h:pointer; {temp for hyphen offset in native-font text}
3789
@!is_hyph:boolean; {whether the last char seen is the font's hyphenchar}
3793
adjust_space_factor;@/
3796
{ added code for native font support }
3797
if is_native_font(cur_font) then begin
3798
if mode>0 then if language<>clang then fix_language;
3804
adjust_space_factor;
3805
if (cur_chr > @"FFFF) then begin
3807
append_char((cur_chr - @"10000) div 1024 + @"D800);
3808
append_char((cur_chr - @"10000) mod 1024 + @"DC00);
3811
append_char(cur_chr);
3813
is_hyph := (cur_chr = hyphen_char[main_f])
3814
or (XeTeX_dash_break_en and (cur_chr = @"2014) or (cur_chr = @"2013));
3815
if (main_h = 0) and is_hyph then main_h := cur_length;
3817
{try to collect as many chars as possible in the same font}
3819
if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native;
3821
if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native;
3822
if cur_cmd=char_num then begin
3825
goto collect_native;
3828
if (font_mapping[main_f] <> 0) then begin
3829
main_k := apply_mapping(font_mapping[main_f], address_of(str_pool[str_start_macro(str_ptr)]), cur_length);
3830
pool_ptr := str_start_macro(str_ptr); { flush the string, as we'll be using the mapped text instead }
3833
for main_p := 0 to main_k - 1 do begin
3834
append_char(mapped_text[main_p]);
3835
if (main_h = 0) and ((mapped_text[main_p] = hyphen_char[main_f])
3836
or (XeTeX_dash_break_en and ((mapped_text[main_p] = @"2014) or (mapped_text[main_p] = @"2013)) ) )
3837
then main_h := cur_length;
3841
if tracing_lost_chars > 0 then begin
3842
temp_ptr := str_start_macro(str_ptr);
3843
main_p := temp_ptr + cur_length;
3844
while (temp_ptr < main_p) do begin
3845
main_k := str_pool[temp_ptr];
3847
if (main_k >= @"D800) and (main_k < @"DC00) then begin
3848
main_k := @"10000 + (main_k - @"D800) * 1024;
3849
main_k := main_k + str_pool[temp_ptr] - @"DC00;
3852
if map_char_to_glyph(main_f, main_k) = 0 then
3853
char_warning(main_f, main_k);
3857
main_k := cur_length;
3860
if mode=hmode then begin
3862
temp_ptr := str_start_macro(str_ptr);
3864
if main_h = 0 then main_h := main_k;
3866
if (not is_char_node(main_pp)) and (type(main_pp)=whatsit_node) and (subtype(main_pp)=native_word_node) and (native_font(main_pp)=main_f) then begin
3868
{ make a new temp string that contains the concatenated text of |tail| + the current word/fragment }
3869
main_k := main_h + native_length(main_pp);
3872
temp_ptr := pool_ptr;
3873
for main_p := 0 to native_length(main_pp) - 1 do
3874
append_char(get_native_char(main_pp, main_p));
3875
for main_p := str_start_macro(str_ptr) to temp_ptr - 1 do
3876
append_char(str_pool[main_p]);
3878
do_locale_linebreaks(temp_ptr, main_k);
3880
pool_ptr := temp_ptr; { discard the temp string }
3881
main_k := cur_length - main_h; { and set main_k to remaining length of new word }
3882
temp_ptr := str_start_macro(str_ptr) + main_h; { pointer to remaining fragment }
3885
while (main_h < main_k) and (str_pool[temp_ptr + main_h] <> hyphen_char[main_f])
3886
and ( (not XeTeX_dash_break_en)
3887
or ((str_pool[temp_ptr + main_h] <> @"2014) and (str_pool[temp_ptr + main_h] <> @"2013)) )
3888
do incr(main_h); { look for next hyphen or end of text }
3889
if (main_h < main_k) then incr(main_h);
3891
{ flag the previous node as no longer valid }
3892
free_native_glyph_info(main_pp);
3893
subtype(main_pp) := deleted_native_node;
3897
do_locale_linebreaks(temp_ptr, main_h); { append fragment of current word }
3899
temp_ptr := temp_ptr + main_h; { advance ptr to remaining fragment }
3900
main_k := main_k - main_h; { decrement remaining length }
3903
while (main_h < main_k) and (str_pool[temp_ptr + main_h] <> hyphen_char[main_f])
3904
and ( (not XeTeX_dash_break_en)
3905
or ((str_pool[temp_ptr + main_h] <> @"2014) and (str_pool[temp_ptr + main_h] <> @"2013)) )
3906
do incr(main_h); { look for next hyphen or end of text }
3907
if (main_h < main_k) then incr(main_h);
3911
if (main_k > 0) or is_hyph then begin
3912
tail_append(new_disc); { add a break if we aren't at end of text (must be a hyphen),
3913
or if last char in original text was a hyphen }
3918
{ must be restricted hmode, so no need for line-breaking or discretionaries }
3919
if (not is_char_node(main_pp)) and (type(main_pp)=whatsit_node) and (subtype(main_pp)=native_word_node) and (native_font(main_pp)=main_f) then begin
3920
{ total string length for the new merged whatsit }
3921
link(main_pp) := new_native_word_node(main_f, main_k + native_length(main_pp));
3922
tail := link(main_pp);
3924
{ copy text from the old one into the new }
3925
for main_p := 0 to native_length(main_pp) - 1 do
3926
set_native_char(tail, main_p, get_native_char(main_pp, main_p));
3927
{ append the new text }
3928
for main_p := 0 to main_k - 1 do
3929
set_native_char(tail, main_p + native_length(main_pp), str_pool[str_start_macro(str_ptr) + main_p]);
3930
set_native_metrics(tail, XeTeX_use_glyph_metrics);
3932
{ flag the previous node as no longer valid }
3933
free_native_glyph_info(main_pp);
3934
subtype(main_pp) := deleted_native_node;
3936
{ package the current string into a |native_word| whatsit }
3937
link(main_pp) := new_native_word_node(main_f, main_k);
3938
tail := link(main_pp);
3939
for main_p := 0 to main_k - 1 do
3940
set_native_char(tail, main_p, str_pool[str_start_macro(str_ptr) + main_p]);
3941
set_native_metrics(tail, XeTeX_use_glyph_metrics);
3945
pool_ptr := str_start_macro(str_ptr);
3948
{ End of added code for native fonts }
3950
adjust_space_factor;@/
3954
non_math(math_given), non_math(math_comp), non_math(delim_num),
3956
non_math(math_given), non_math(XeTeX_math_given), non_math(math_comp), non_math(delim_num),
3960
procedure append_italic_correction;
3962
var p:pointer; {|char_node| at the tail of the current list}
3963
@!f:internal_font_number; {the font in the |char_node|}
3964
begin if tail<>head then
3965
begin if is_char_node(tail) then p:=tail
3966
else if type(tail)=ligature_node then p:=lig_char(tail)
3969
procedure append_italic_correction;
3971
var p:pointer; {|char_node| at the tail of the current list}
3972
@!f:internal_font_number; {the font in the |char_node|}
3973
begin if tail<>head then
3974
begin if is_char_node(tail) then p:=tail
3975
else if type(tail)=ligature_node then p:=lig_char(tail)
3976
else if (type(tail)=whatsit_node) then begin
3977
if (subtype(tail)=native_word_node) then begin
3978
tail_append(new_kern(get_native_italic_correction(tail))); subtype(tail):=explicit;
3980
else if (subtype(tail)=glyph_node) then begin
3981
tail_append(new_kern(get_native_glyph_italic_correction(tail))); subtype(tail):=explicit;
3989
if c>=0 then if c<256 then pre_break(tail):=new_character(cur_font,c);
3991
if c>=0 then if c<=biggest_char then pre_break(tail):=new_character(cur_font,c);
3995
if type(p)<>kern_node then if type(p)<>ligature_node then
3996
begin print_err("Improper discretionary list");
3998
if type(p)<>kern_node then if type(p)<>ligature_node then
3999
if (type(p)<>whatsit_node) or ((subtype(p)<>native_word_node)
4000
and (subtype(p)<>deleted_native_node)
4001
and (subtype(p)<>glyph_node)) then
4002
begin print_err("Improper discretionary list");
4006
@!a,@!h,@!x,@!w,@!delta:scaled; {heights and widths, as explained above}
4008
@!a,@!h,@!x,@!w,@!delta,@!lsb,@!rsb:scaled; {heights and widths, as explained above}
4012
a:=char_width(f)(char_info(f)(character(p)));@/
4014
if is_native_font(f) then
4016
if a=0 then get_native_char_sidebearings(f, cur_val, address_of(lsb), address_of(rsb))
4018
else a:=char_width(f)(char_info(f)(character(p)));@/
4022
if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then
4023
q:=new_character(f,cur_chr)
4025
if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then
4026
begin q:=new_character(f,cur_chr); cur_val:=cur_chr
4031
i:=char_info(f)(character(q));
4032
w:=char_width(f)(i); h:=char_height(f)(height_depth(i));
4034
if is_native_font(f) then begin
4036
get_native_char_height_depth(f, cur_val, address_of(h), address_of(delta))
4037
{using delta as scratch space for the unneeded depth value}
4039
i:=char_info(f)(character(q));
4040
w:=char_width(f)(i); h:=char_height(f)(height_depth(i))
4045
delta:=round((w-a)/float_constant(2)+h*t-x*s);
4047
if is_native_font(f) and (a=0) then { special case for non-spacing marks }
4048
delta:=round((w-lsb+rsb)/float_constant(2)+h*t-x*s)
4049
else delta:=round((w-a)/float_constant(2)+h*t-x*s);
4053
whatsit_node: @<Let |d| be the width of the whatsit |p|@>;
4055
whatsit_node: @<Let |d| be the width of the whatsit |p|, and |goto found| if ``visible''@>;
4059
letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
4062
letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
4063
if is_active_math_char(c) then
4067
math_char_num: begin scan_fifteen_bit_int; c:=cur_val;
4071
if cur_chr = 2 then begin { \XeTeXmathchar }
4072
scan_math_class_int; c := set_class_field(cur_val);
4073
scan_math_fam_int; c := c + set_family_field(cur_val);
4074
scan_usv_num; c := c + cur_val;
4075
end else if cur_chr = 1 then begin { \XeTeXmathcharnum }
4076
scan_xetex_math_char_int; c := cur_val;
4077
end else begin scan_fifteen_bit_int;
4078
c := set_class_field(cur_val div @"1000) +
4079
set_family_field((cur_val mod @"1000) div @"100) +
4080
(cur_val mod @"100);
4085
math_given: c:=cur_chr;
4086
delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000;
4089
c := set_class_field(cur_chr div @"1000) +
4090
set_family_field((cur_chr mod @"1000) div @"100) +
4091
(cur_chr mod @"100);
4093
XeTeX_math_given: c:=cur_chr;
4095
if cur_chr=1 then begin {\XeTeXdelimiter <cls> <fam> <usv>}
4096
scan_math_class_int; c := set_class_field(cur_val);
4097
scan_math_fam_int; c := c + set_family_field(cur_val);
4098
scan_usv_num; c := c + cur_val;
4099
end else begin {\delimiter <27-bit delcode>}
4101
c := cur_val div @'10000; {get the 'small' delimiter field}
4102
c := set_class_field(c div @"1000) +
4103
set_family_field((c mod @"1000) div @"100) +
4104
(c mod @"100); {and convert it to a xetex mathchar code}
4109
math_type(p):=math_char; character(p):=qi(c mod 256);
4110
if (c>=var_code)and fam_in_range then fam(p):=cur_fam
4111
else fam(p):=(c div 256) mod 16;
4113
math_type(p):=math_char; character(p):=qi(c mod @"10000);
4114
if (is_var_family(c)) and fam_in_range then plane_and_fam_field(p):=cur_fam
4115
else plane_and_fam_field(p):=(math_fam_field(c));
4116
plane_and_fam_field(p) := plane_and_fam_field(p) + (math_char_field(c) div @"10000) * @"100;
4120
mmode+math_char_num: begin scan_fifteen_bit_int; set_math_char(cur_val);
4123
mmode+math_char_num: if cur_chr = 2 then begin { \XeTeXmathchar }
4124
scan_math_class_int; t := set_class_field(cur_val);
4125
scan_math_fam_int; t := t + set_family_field(cur_val);
4126
scan_usv_num; t := t + cur_val;
4128
end else if cur_chr = 1 then begin { \XeTeXmathcharnum }
4129
scan_xetex_math_char_int; set_math_char(cur_val);
4130
end else begin scan_fifteen_bit_int;
4131
set_math_char(set_class_field(cur_val div @"1000) +
4132
set_family_field((cur_val mod @"1000) div @"100) +
4133
(cur_val mod @"100));
4138
mmode+math_given: set_math_char(cur_chr);
4139
mmode+delim_num: begin scan_twenty_seven_bit_int;
4140
set_math_char(cur_val div @'10000);
4142
mmode+math_given: begin
4143
set_math_char(set_class_field(cur_chr div @"1000) +
4144
set_family_field((cur_chr mod @"1000) div @"100) +
4145
(cur_chr mod @"100));
4147
mmode+XeTeX_math_given: set_math_char(cur_chr);
4148
mmode+delim_num: begin
4149
if cur_chr=1 then begin {\XeTeXdelimiter}
4150
scan_math_class_int; t := set_class_field(cur_val);
4151
scan_math_fam_int; t := t + set_family_field(cur_val);
4152
scan_usv_num; t := t + cur_val;
4156
cur_val:=cur_val div @'10000; {discard the large delimiter code}
4157
set_math_char(set_class_field(cur_val div @"1000) +
4158
set_family_field((cur_val mod @"1000) div @"100) +
4159
(cur_val mod @"100));
4164
procedure set_math_char(@!c:integer);
4165
var p:pointer; {the new noad}
4166
begin if c>=@'100000 then
4167
@<Treat |cur_chr|...@>
4168
else begin p:=new_noad; math_type(nucleus(p)):=math_char;
4169
character(nucleus(p)):=qi(c mod 256);
4170
fam(nucleus(p)):=(c div 256) mod 16;
4172
begin if fam_in_range then fam(nucleus(p)):=cur_fam;
4175
else type(p):=ord_noad+(c div @'10000);
4177
procedure set_math_char(@!c:integer);
4178
var p,q,r:pointer; {the new noad}
4180
begin if is_active_math_char(c) then
4181
@<Treat |cur_chr|...@>
4182
else begin p:=new_noad; math_type(nucleus(p)):=math_char;
4183
ch:=math_char_field(c);
4184
character(nucleus(p)):=qi(ch mod @"10000);
4185
plane_and_fam_field(nucleus(p)):=math_fam_field(c);
4186
if is_var_family(c) then
4187
begin if fam_in_range then plane_and_fam_field(nucleus(p)):=cur_fam;
4190
else type(p):=ord_noad+math_class_field(c);
4191
plane_and_fam_field(nucleus(p)) := plane_and_fam_field(nucleus(p)) + (ch div @"10000) * @"100;
4195
procedure scan_delimiter(@!p:pointer;@!r:boolean);
4196
begin if r then scan_twenty_seven_bit_int
4198
procedure scan_delimiter(@!p:pointer;@!r:boolean);
4201
if cur_chr=1 then begin {\XeTeXradical}
4202
cur_val1 := @"40000000; {extended delcode flag}
4203
scan_math_fam_int; cur_val1 := cur_val1 + cur_val * @"200000;
4204
scan_usv_num; cur_val := cur_val1 + cur_val;
4211
letter,other_char: cur_val:=del_code(cur_chr);
4212
delim_num: scan_twenty_seven_bit_int;
4213
othercases cur_val:=-1
4215
letter,other_char: begin
4216
cur_val:=del_code(cur_chr);
4218
delim_num: if cur_chr=1 then begin {\XeTeXdelimiter}
4219
cur_val1 := @"40000000; {extended delcode flag}
4220
scan_math_class_int; {discarded}
4221
scan_math_fam_int; cur_val1 := cur_val1 + cur_val * @"200000;
4222
scan_usv_num; cur_val := cur_val1 + cur_val;
4223
end else scan_delimiter_int; {normal \delimiter}
4224
othercases begin cur_val:=-1; end;
4228
if cur_val<0 then @<Report that an invalid delimiter code is being changed
4229
to null; set~|cur_val:=0|@>;
4230
small_fam(p):=(cur_val div @'4000000) mod 16;
4231
small_char(p):=qi((cur_val div @'10000) mod 256);
4232
large_fam(p):=(cur_val div 256) mod 16;
4233
large_char(p):=qi(cur_val mod 256);
4235
if cur_val<0 then begin @<Report that an invalid delimiter code is being changed
4236
to null; set~|cur_val:=0|@>;
4238
if cur_val>=@"40000000 then begin {extended delcode, only one size}
4239
small_plane_and_fam_field(p) := ((cur_val mod @"200000) div @"10000) * @"100 {plane}
4240
+ (cur_val div @"200000) mod @"100; {family}
4241
small_char_field(p) := qi(cur_val mod @"10000);
4242
large_plane_and_fam_field(p) := 0;
4243
large_char_field(p) := 0;
4244
end else begin {standard delcode, 4-bit families and 8-bit char codes}
4245
small_plane_and_fam_field(p) := (cur_val div @'4000000) mod 16;
4246
small_char_field(p) := qi((cur_val div @'10000) mod 256);
4247
large_plane_and_fam_field(p) := (cur_val div 256) mod 16;
4248
large_char_field(p) := qi(cur_val mod 256);
4260
scan_fifteen_bit_int;
4261
character(accent_chr(tail)):=qi(cur_val mod 256);
4262
if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
4263
else fam(accent_chr(tail)):=(cur_val div 256) mod 16;
4265
if cur_chr=1 then begin
4266
scan_math_class_int; c := set_class_field(cur_val);
4267
scan_math_fam_int; c := c + set_family_field(cur_val);
4268
scan_usv_num; cur_val := cur_val + c;
4271
scan_fifteen_bit_int;
4272
cur_val := set_class_field(cur_val div @"1000) +
4273
set_family_field((cur_val mod @"1000) div @"100) +
4274
(cur_val mod @"100);
4276
character(accent_chr(tail)):=qi(cur_val mod @"10000);
4277
if (is_var_family(cur_val))and fam_in_range then plane_and_fam_field(accent_chr(tail)):=cur_fam
4278
else plane_and_fam_field(accent_chr(tail)):=math_fam_field(cur_val);
4279
plane_and_fam_field(accent_chr(tail))
4280
:= plane_and_fam_field(accent_chr(tail)) + (math_char_field(cur_val) div @"10000) * @"100;
4284
@* \[49] Mode-independent processing.
4286
@* \[49] Mode-independent processing.
4293
any_mode(XeTeX_def_code),
4297
@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
4299
@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
4300
@d word_define1(#)==if global then geq_word_define1(#)@+else eq_word_define1(#)
4304
@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
4305
@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
4306
@d count_def_code=2 {|shorthand_def| for \.{\\countdef}}
4307
@d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}}
4308
@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}}
4309
@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}}
4310
@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
4311
@d char_sub_def_code=7 {|shorthand_def| for \.{\\charsubdef}}
4313
@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
4314
@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
4315
@d count_def_code=2 {|shorthand_def| for \.{\\countdef}}
4316
@d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}}
4317
@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}}
4318
@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}}
4319
@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
4320
@d char_sub_def_code=7 {|shorthand_def| for \.{\\charsubdef}}
4321
@d XeTeX_math_char_num_def_code=8
4322
@d XeTeX_math_char_def_code=9
4326
primitive("mathchardef",shorthand_def,math_char_def_code);@/
4327
@!@:math_char_def_}{\.{\\mathchardef} primitive@>
4329
primitive("mathchardef",shorthand_def,math_char_def_code);@/
4330
primitive("XeTeXmathcharnumdef",shorthand_def,XeTeX_math_char_num_def_code);@/
4331
primitive("XeTeXmathchardef",shorthand_def,XeTeX_math_char_def_code);@/
4332
@!@:math_char_def_}{\.{\\mathchardef} primitive@>
4336
math_char_def_code: print_esc("mathchardef");
4338
math_char_def_code: print_esc("mathchardef");
4339
XeTeX_math_char_def_code: print_esc("XeTeXmathchardef");
4340
XeTeX_math_char_num_def_code: print_esc("XeTeXmathcharnumdef");
4344
math_given: begin print_esc("mathchar"); print_hex(chr_code);
4347
math_given: begin print_esc("mathchar"); print_hex(chr_code);
4349
XeTeX_math_given: begin print_esc("XeTeXmathchar"); print_hex(chr_code);
4354
else begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256);
4356
else begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,too_big_char);
4360
char_def_code: begin scan_char_num; define(p,char_given,cur_val);
4362
char_def_code: begin scan_usv_num; define(p,char_given,cur_val);
4366
math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val);
4369
math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val);
4371
XeTeX_math_char_num_def_code: begin scan_xetex_math_char_int;
4372
define(p, XeTeX_math_given, cur_val);
4374
XeTeX_math_char_def_code: begin
4375
scan_math_class_int; n := set_class_field(cur_val);
4376
scan_math_fam_int; n := n + set_family_field(cur_val);
4377
scan_usv_num; n := n + cur_val;
4378
define(p, XeTeX_math_given, n);
4383
primitive("mathcode",def_code,math_code_base);
4385
primitive("mathcode",def_code,math_code_base);
4386
primitive("XeTeXmathcodenum",XeTeX_def_code,math_code_base);
4387
primitive("XeTeXmathcode",XeTeX_def_code,math_code_base+1);
4391
primitive("delcode",def_code,del_code_base);
4393
primitive("delcode",def_code,del_code_base);
4394
primitive("XeTeXdelcodenum",XeTeX_def_code,del_code_base);
4395
primitive("XeTeXdelcode",XeTeX_def_code,del_code_base+1);
4399
def_family: print_size(chr_code-math_font_base);
4401
XeTeX_def_code: if chr_code=math_code_base then print_esc("XeTeXmathcodenum")
4402
else if chr_code=math_code_base+1 then print_esc("XeTeXmathcode")
4403
else if chr_code=del_code_base then print_esc("XeTeXdelcodenum")
4404
else print_esc("XeTeXdelcode");
4405
def_family: print_size(chr_code-math_font_base);
4409
def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>;
4411
XeTeX_def_code: begin
4412
if cur_chr = math_code_base then begin
4413
p:=cur_chr; scan_char_num;
4415
scan_optional_equals;
4416
scan_xetex_math_char_int;
4417
define(p,data,hi(cur_val));
4419
else if cur_chr = math_code_base+1 then begin
4420
p:=cur_chr-1; scan_char_num;
4422
scan_optional_equals;
4423
scan_math_class_int; n := set_class_field(cur_val);
4424
scan_math_fam_int; n := n + set_family_field(cur_val);
4425
scan_usv_num; n := n + cur_val;
4426
define(p,data,hi(n));
4428
else if cur_chr = del_code_base then begin
4429
p:=cur_chr; scan_char_num;
4431
scan_optional_equals;
4432
scan_int; {scan_xetex_del_code_int; !!FIXME!!}
4433
word_define(p,hi(cur_val));
4436
bit usage in delcode values:
4437
original layout: @"00cffCFF small/LARGE family & char
4438
extended: @"40000000 FLAG
4439
+ ff << 21 (mult by @"200000) FAMILY
4440
+ 1ccccc (21 bits) USV
4442
p:=cur_chr-1; scan_char_num;
4444
scan_optional_equals;
4445
n := @"40000000; {extended delcode flag}
4446
scan_math_fam_int; n := n + cur_val * @"200000;
4447
scan_usv_num; n := n + cur_val;
4448
word_define(p,hi(n));
4451
def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>;
4455
if p<256 then xord[p]:=cur_val
4456
else if p<512 then xchr[p-256]:=cur_val
4457
else if p<768 then xprn[p-512]:=cur_val
4458
else if p<math_code_base then define(p,data,cur_val)
4459
else if p<del_code_base then define(p,data,hi(cur_val))
4461
if p<math_code_base then define(p,data,cur_val)
4462
else if p<del_code_base then begin
4463
if cur_val=@"8000 then cur_val:=active_math_char
4464
else cur_val:=set_class_field(cur_val div @"1000) +
4465
set_family_field((cur_val mod @"1000) div @"100) +
4466
(cur_val mod @"100); {!!FIXME!! check how this is used}
4467
define(p,data,hi(cur_val));
4471
-- from Omega; not needed with new xetex delimiter coding
4473
else word_define(p,cur_val);
4476
cur_val1 := cur_val mod @"1000; { large delim code }
4477
cur_val1 := set_family_field(cur_val1 div @"100) + cur_val1 mod @"100;
4478
cur_val := cur_val div @"1000;
4479
cur_val := set_class_field((cur_val div @"1000) mod 8) +
4480
set_family_field((cur_val div @"100) mod @"10) +
4481
(cur_val mod @"100);
4482
word_define(p, cur_val);
4483
word_define1(p, cur_val1);
4490
else n:=biggest_char
4494
def_family: begin p:=cur_chr; scan_four_bit_int; p:=p+cur_val;
4496
def_family: begin p:=cur_chr; scan_math_fam_int; p:=p+cur_val;
4500
if str_eq_str(font_name[f],cur_name)and str_eq_str(font_area[f],cur_area) then
4502
if str_eq_str(font_name[f],cur_name) and
4503
(((cur_area = "") and is_native_font(f)) or str_eq_str(font_area[f],cur_area)) then
4507
set_font:begin print("select font "); slow_print(font_name[chr_code]);
4509
set_font:begin print("select font ");
4510
font_name_str:=font_name[chr_code];
4511
if is_native_font(chr_code) then begin
4513
for n:=0 to length(font_name_str) - 1 do
4514
if str_pool[str_start_macro(font_name_str) + n] = """" then quote_char:="'";
4515
print_char(quote_char);
4516
slow_print(font_name_str);
4517
print_char(quote_char);
4519
slow_print(font_name_str);
4523
begin a_close(read_file[n]); read_open[n]:=closed;
4525
begin u_close(read_file[n]); read_open[n]:=closed;
4529
and a_open_in(read_file[n], kpse_tex_format) then
4530
read_open[n]:=just_open;
4532
and u_open_in(read_file[n], kpse_tex_format, XeTeX_default_input_mode, XeTeX_default_input_encoding) then
4535
name_in_progress:=true;
4537
stop_at_space:=false;
4539
while (k<name_length16)and(more_name(name_of_file16[k])) do
4541
stop_at_space:=true;
4543
name_in_progress:=false;
4544
read_open[n]:=just_open;
4549
@!c:eight_bits; {character code}
4551
@!c:ASCII_code; {character code}
4557
begin c:=t mod max_char_val;
4561
@* \[50] Dumping and undumping the tables.
4563
@* \[50] Dumping and undumping the tables.
4567
@!format_engine: ^text_char;
4569
@!format_engine: ^char;
4573
@!format_engine: ^text_char;
4575
@!format_engine: ^char;
4579
format_engine:=xmalloc_array(text_char,x+4);
4581
format_engine:=xmalloc_array(char,x+4);
4585
format_engine:=xmalloc_array(text_char, x);
4587
format_engine:=xmalloc_array(char, x);
4591
dump_things(str_start[0], str_ptr+1);
4593
dump_things(str_start_macro(too_big_char), str_ptr+1-too_big_char);
4597
undump_checked_things(0, pool_ptr, str_start[0], str_ptr+1);@/
4599
undump_checked_things(0, pool_ptr, str_start_macro(too_big_char), str_ptr+1-too_big_char);@/
4603
print_file_name(font_name[k],font_area[k],"");
4605
if is_native_font(k) then
4606
begin print_file_name(font_name[k],"","");
4607
print_err("Can't \dump a format with preloaded native fonts");
4608
help2("You really, really don't want to do this.")
4609
("It won't work, and only confuses me.");
4612
else print_file_name(font_name[k],font_area[k],"");
4616
begin {Allocate the font arrays}
4618
begin {Allocate the font arrays}
4619
font_mapping:=xmalloc_array(void_pointer, font_max);
4620
font_layout_engine:=xmalloc_array(void_pointer, font_max);
4621
font_flags:=xmalloc_array(char, font_max);
4622
font_letter_space:=xmalloc_array(scaled, font_max);
4626
font_bc:=xmalloc_array(eight_bits, font_max);
4627
font_ec:=xmalloc_array(eight_bits, font_max);
4629
font_bc:=xmalloc_array(UTF16_code, font_max);
4630
font_ec:=xmalloc_array(UTF16_code, font_max);
4634
dump_int(trie_op_ptr);
4636
dump_int(max_hyph_char);
4637
dump_int(trie_op_ptr);
4641
for k:=255 downto 0 do if trie_used[k]>min_quarterword then
4643
for k:=biggest_lang downto 0 do if trie_used[k]>min_quarterword then
4647
undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
4649
undump_int(max_hyph_char);
4650
undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
4654
init for k:=0 to 255 do trie_used[k]:=min_quarterword;@+tini@;@/
4657
init for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;@+tini@;@/
4662
setup_bound_var (15000)('max_strings')(max_strings);
4664
setup_bound_var (15000)('max_strings')(max_strings);
4665
max_strings:=max_strings+too_big_char; {the max_strings value doesn't include the 64K synthetic strings}
4669
input_file:=xmalloc_array (alpha_file, max_in_open);
4671
input_file:=xmalloc_array (unicode_file, max_in_open);
4675
print_file_name(0, log_name, 0); print_char(".");
4677
print(log_name); print_char(".");
4681
{Allocate and initialize font arrays}
4683
{Allocate and initialize font arrays}
4684
font_mapping:=xmalloc_array(void_pointer, font_max);
4685
font_layout_engine:=xmalloc_array(void_pointer, font_max);
4686
font_flags:=xmalloc_array(char, font_max);
4687
font_letter_space:=xmalloc_array(scaled, font_max);
4691
font_bc:=xmalloc_array(eight_bits, font_max);
4692
font_ec:=xmalloc_array(eight_bits, font_max);
4694
font_bc:=xmalloc_array(UTF16_code, font_max);
4695
font_ec:=xmalloc_array(UTF16_code, font_max);
4699
@* \[53] Extensions.
4701
@* \[53] Extensions.
4705
@d write_stream(#) == type(#+1) {stream number (0 to 17)}
4706
@d mubyte_zero == 64
4707
@d write_mubyte(#) == subtype(#+1) {mubyte value + |mubyte_zero|}
4709
@d write_stream(#) == info(#+1) {stream number (0 to 17)}
4713
@d set_language_code=5 {command modifier for \.{\\setlanguage}}
4715
@d set_language_code=5 {command modifier for \.{\\setlanguage}}
4717
@d pdftex_first_extension_code = 6
4718
@d pdf_save_pos_node == pdftex_first_extension_code + 0
4720
@d pic_file_code=41 { command modifier for \.{\\XeTeXpicfile}, skipping codes pdfTeX might use }
4721
@d pdf_file_code=42 { command modifier for \.{\\XeTeXpdffile} }
4722
@d glyph_code=43 { command modifier for \.{\\XeTeXglyph} }
4724
@d XeTeX_input_encoding_extension_code=44
4725
@d XeTeX_default_encoding_extension_code=45
4726
@d XeTeX_linebreak_locale_extension_code=46
4730
@!@:set_language_}{\.{\\setlanguage} primitive@>
4732
@!@:set_language_}{\.{\\setlanguage} primitive@>
4734
@ The \.{\\XeTeXpicfile} and \.{\\XeTeXpdffile} primitives are only defined in extended mode.
4736
@<Generate all \eTeX\ primitives@>=
4737
primitive("XeTeXpicfile",extension,pic_file_code);@/
4738
primitive("XeTeXpdffile",extension,pdf_file_code);@/
4739
primitive("XeTeXglyph",extension,glyph_code);@/
4740
primitive("XeTeXlinebreaklocale", extension, XeTeX_linebreak_locale_extension_code);@/
4742
primitive("pdfsavepos",extension,pdf_save_pos_node);@/
4746
set_language_code:print_esc("setlanguage");
4748
set_language_code:print_esc("setlanguage");
4749
pic_file_code:print_esc("XeTeXpicfile");
4750
pdf_file_code:print_esc("XeTeXpdffile");
4751
glyph_code:print_esc("XeTeXglyph");
4752
XeTeX_linebreak_locale_extension_code:print_esc("XeTeXlinebreaklocale");
4754
pdf_save_pos_node: print_esc("pdfsavepos");
4758
set_language_code:@<Implement \.{\\setlanguage}@>;
4760
set_language_code:@<Implement \.{\\setlanguage}@>;
4761
pic_file_code:@<Implement \.{\\XeTeXpicfile}@>;
4762
pdf_file_code:@<Implement \.{\\XeTeXpdffile}@>;
4763
glyph_code:@<Implement \.{\\XeTeXglyph}@>;
4764
XeTeX_input_encoding_extension_code:@<Implement \.{\\XeTeXinputencoding}@>;
4765
XeTeX_default_encoding_extension_code:@<Implement \.{\\XeTeXdefaultencoding}@>;
4766
XeTeX_linebreak_locale_extension_code:@<Implement \.{\\XeTeXlinebreaklocale}@>;
4768
pdf_save_pos_node: @<Implement \.{\\pdfsavepos}@>;
4772
@ @<Display the whatsit...@>=
4774
procedure print_native_word(@!p:pointer);
4777
for i:=0 to native_length(p) - 1 do print_char(get_native_char(p,i));
4780
@ @<Display the whatsit...@>=
4784
if write_stream(p) <> mubyte_zero then
4786
print_char ("<"); print_int (write_stream(p)-mubyte_zero);
4787
if (write_stream(p)-mubyte_zero = 2) or
4788
(write_stream(p)-mubyte_zero = 3) then
4790
print_char (":"); print_int (write_mubyte(p)-mubyte_zero);
4798
othercases print("whatsit?")
4800
native_word_node:begin
4801
print_esc(font_id_text(native_font(p)));
4803
print_native_word(p);
4805
deleted_native_node:
4808
print_esc(font_id_text(native_font(p)));
4810
print_int(native_glyph(p));
4812
pic_node,pdf_node: begin
4813
if subtype(p) = pic_node then print_esc("XeTeXpicfile")
4814
else print_esc("XeTeXpdffile");
4816
for i:=0 to pic_path_length(p)-1 do
4817
print_visible_char(pic_path_byte(p, i));
4820
pdf_save_pos_node: print_esc("pdfsavepos");
4821
othercases print("whatsit?")
4825
@ @<Make a partial copy of the whatsit...@>=
4827
@ Picture nodes are tricky in that they are variable size.
4828
@d total_pic_node_size(#) == (pic_node_size + (pic_path_length(#) + sizeof(memory_word) - 1) div sizeof(memory_word))
4830
@<Make a partial copy of the whatsit...@>=
4834
othercases confusion("ext2")
4836
native_word_node: begin words:=native_size(p);
4839
begin decr(words); mem[r+words]:=mem[p+words]; end;
4840
native_glyph_info_ptr(r):=0; native_glyph_count(r):=0;
4841
copy_native_glyph_info(p, r);
4843
deleted_native_node: begin words:=native_size(p);
4846
glyph_node: begin r:=get_node(glyph_node_size);
4847
words:=glyph_node_size;
4849
pic_node,pdf_node: begin words:=total_pic_node_size(p);
4853
r := get_node(small_node_size);
4854
othercases confusion("ext2")
4858
othercases confusion("ext3")
4860
native_word_node: begin free_native_glyph_info(p); free_node(p,native_size(p)); end;
4861
deleted_native_node: free_node(p,native_size(p));
4862
glyph_node: free_node(p,glyph_node_size);
4863
pic_node,pdf_node: free_node(p,total_pic_node_size(p));
4865
free_node(p, small_node_size);
4866
othercases confusion("ext3")
4870
@ @<Incorporate a whatsit node into a vbox@>=do_nothing
4872
@ @<Incorporate a whatsit node into a vbox@>=
4874
if (subtype(p)=pic_node)
4875
or (subtype(p)=pdf_node)
4877
x := x + d + height(p);
4879
if width(p) > w then w := width(p);
4885
@ @<Incorporate a whatsit node into an hbox@>=do_nothing
4887
@ @<Incorporate a whatsit node into an hbox@>=
4893
{ merge with any following word fragments in same font, discarding discretionary breaks }
4894
while (link(q) <> p) do q := link(q); { bring q up in preparation for deletion of nodes starting at p }
4897
if (pp <> null) and (not is_char_node(pp)) then begin
4898
if (type(pp) = whatsit_node)
4899
and (subtype(pp) = native_word_node)
4900
and (native_font(pp) = native_font(p)) then begin
4904
else if (type(pp) = disc_node) then begin
4906
if (ppp <> null) and (not is_char_node(ppp))
4907
and (type(ppp) = whatsit_node)
4908
and (subtype(ppp) = native_word_node)
4909
and (native_font(ppp) = native_font(p)) then begin
4916
{ now pp points to the non-native_word node that ended the chain, or null }
4918
{ we can just check type(p)=whatsit_node below, as we know that the chain
4919
contains only discretionaries and native_word nodes, no other whatsits or char_nodes }
4921
if (pp <> link(p)) then begin
4922
{ found a chain of at least two pieces starting at p }
4924
p := link(q); { the first fragment }
4925
while (p <> pp) do begin
4926
if (type(p) = whatsit_node) then
4927
total_chars := total_chars + native_length(p); { accumulate char count }
4928
ppp := p; { remember last node seen }
4929
p := link(p); { point to next fragment or discretionary or terminator }
4932
p := link(q); { the first fragment again }
4933
pp := new_native_word_node(native_font(p), total_chars); { make new node for merged word }
4934
link(q) := pp; { link to preceding material }
4935
link(pp) := link(ppp); { attach remainder of hlist to it }
4936
link(ppp) := null; { and detach from the old fragments }
4938
{ copy the chars into new node }
4942
if (type(ppp) = whatsit_node) then
4943
for k := 0 to native_length(ppp)-1 do begin
4944
set_native_char(pp, total_chars, get_native_char(ppp, k));
4950
flush_node_list(p); { delete the fragments }
4951
p := link(q); { update p to point to the new node }
4952
set_native_metrics(p, XeTeX_use_glyph_metrics); { and measure it (i.e., re-do the OT layout) }
4955
{ now incorporate the native_word node measurements into the box we're packing }
4956
if height(p) > h then
4958
if depth(p) > d then
4963
glyph_node, pic_node, pdf_node:
4965
if height(p) > h then
4967
if depth(p) > d then
4980
@ @<Let |d| be the width of the whatsit |p|@>=d:=0
4982
@ @<Let |d| be the width of the whatsit |p|, and |goto found| if ``visible''@>=
4983
if (subtype(p)=native_word_node)
4984
or (subtype(p)=glyph_node)
4985
or (subtype(p)=pic_node)
4986
or (subtype(p)=pdf_node)
4995
@ @d adv_past(#)==@+if subtype(#)=language_node then
4996
begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#);@+end
4998
@ @d adv_past(#)==@+if subtype(#)=language_node then
4999
begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#);@+end
5000
else if (subtype(#)=native_word_node)
5001
or (subtype(#)=glyph_node)
5002
or (subtype(#)=pic_node)
5003
or (subtype(#)=pdf_node)
5005
begin act_width:=act_width+width(#); end
5009
@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>=
5012
@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>=
5014
if (subtype(p)=pic_node)
5015
or (subtype(p)=pdf_node)
5017
page_total := page_total + page_depth + height(p);
5018
page_depth := depth(p);
5025
@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>=
5028
@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>=
5030
if (subtype(p)=pic_node)
5031
or (subtype(p)=pdf_node)
5033
cur_height := cur_height + prev_dp + height(p); prev_dp := depth(p);
5040
@ @<Output the whatsit node |p| in a vlist@>=
5043
@ @<Output the whatsit node |p| in a vlist@>=
5046
pic_node, pdf_node: begin
5047
save_h:=dvi_h; save_v:=dvi_v;
5048
cur_v:=cur_v+height(p);
5049
pic_out(p, subtype(p) = pdf_node);
5050
dvi_h:=save_h; dvi_v:=save_v;
5051
cur_v:=save_v+depth(p); cur_h:=left_edge;
5055
@<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
5065
@ @<Output the whatsit node |p| in an hlist@>=
5068
@ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>=
5070
pdf_last_x_pos := cur_h + cur_h_offset;
5071
pdf_last_y_pos := cur_page_height - cur_v - cur_v_offset
5074
@ @<Calculate page dimensions and margins@>=
5075
cur_h_offset := h_offset + (unity * 7227) / 100;
5076
cur_v_offset := v_offset + (unity * 7227) / 100;
5077
if pdf_page_width <> 0 then
5078
cur_page_width := pdf_page_width
5080
cur_page_width := width(p) + 2*cur_h_offset;
5081
if pdf_page_height <> 0 then
5082
cur_page_height := pdf_page_height
5084
cur_page_height := height(p) + depth(p) + 2*cur_v_offset
5087
@!cur_page_width: scaled; {width of page being shipped}
5088
@!cur_page_height: scaled; {height of page being shipped}
5089
@!cur_h_offset: scaled; {horizontal offset of page being shipped}
5090
@!cur_v_offset: scaled; {vertical offset of page being shipped}
5092
@ @<Output the whatsit node |p| in an hlist@>=
5095
native_word_node, glyph_node: begin
5096
{ synch DVI state to TeX state }
5098
f := native_font(p);
5099
if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
5101
if subtype(p) = glyph_node then begin
5102
dvi_out(set_glyph_string);
5104
dvi_two(1); { glyph count }
5105
dvi_four(0); { x-offset as fixed point }
5106
dvi_two(native_glyph(p));
5107
cur_h := cur_h + width(p);
5109
if native_glyph_info_ptr(p) <> 0 then begin
5110
len := make_xdv_glyph_array_data(p);
5111
for k := 0 to len-1 do
5112
dvi_out(xdv_buffer_byte(k));
5114
cur_h := cur_h + width(p);
5120
pic_node, pdf_node: begin
5121
save_h:=dvi_h; save_v:=dvi_v;
5123
edge:=cur_h+width(p);
5124
if cur_dir=right_to_left then cur_h:=edge;
5125
pic_out(p, subtype(p) = pdf_node);
5126
dvi_h:=save_h; dvi_v:=save_v;
5127
cur_h:=edge; cur_v:=base_line;
5131
@<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
5141
procedure special_out(@!p:pointer);
5142
var old_setting:0..max_selector; {holds print |selector|}
5143
@!k:pool_pointer; {index into |str_pool|}
5144
begin synch_h; synch_v;@/
5146
procedure special_out(@!p:pointer);
5147
var old_setting:0..max_selector; {holds print |selector|}
5148
@!k:pool_pointer; {index into |str_pool|}
5149
begin synch_h; synch_v;@/
5150
doing_special := true;
5154
for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k]));
5155
spec_out := spec_sout; mubyte_out := mubyte_sout; mubyte_log := mubyte_slog;
5156
special_printing := false; cs_converting := false;
5157
active_noconvert := false;
5158
pool_ptr:=str_start[str_ptr]; {erase the string}
5160
for k:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[k]));
5161
pool_ptr:=str_start_macro(str_ptr); {erase the string}
5162
doing_special := false;
5166
@!j:small_number; {write stream number}
5168
@!j:small_number; {write stream number}
5173
print(so(str_pool[str_start[str_ptr]+d])); {N.B.: not |print_char|}
5175
print(so(str_pool[str_start_macro(str_ptr)+d])); {N.B.: not |print_char|}
5179
begin str_pool[str_start[str_ptr]+d]:=xchr[str_pool[str_start[str_ptr]+d]];
5180
if (str_pool[str_start[str_ptr]+d]=null_code)
5183
if (str_pool[str_start_macro(str_ptr)+d]=null_code)
5187
system(stringcast(address_of(str_pool[str_start[str_ptr]])));
5189
if name_of_file then libc_free(name_of_file);
5190
name_of_file := xmalloc(cur_length * 3 + 2);
5192
for d:=0 to cur_length-1 do append_to_name(str_pool[str_start_macro(str_ptr)+d]);
5193
name_of_file[k+1] := 0;
5194
system(name_of_file + 1);
5198
pool_ptr:=str_start[str_ptr]; {erase the string}
5200
pool_ptr:=str_start_macro(str_ptr); {erase the string}
5204
@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
5206
@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
5207
procedure pic_out(@!p:pointer; @!is_pdf:boolean);
5214
dvi_out(pic_box_type(p))
5217
dvi_four(pic_transform1(p));
5218
dvi_four(pic_transform2(p));
5219
dvi_four(pic_transform3(p));
5220
dvi_four(pic_transform4(p));
5221
dvi_four(pic_transform5(p));
5222
dvi_four(pic_transform6(p));
5223
dvi_two(pic_page(p));
5224
dvi_two(pic_path_length(p));
5225
for i:=0 to pic_path_length(p)-1 do
5226
dvi_out(pic_path_byte(p, i));
5232
language_node:do_nothing;
5234
language_node,deleted_native_node:do_nothing;
5238
@ @<Finish the extensions@>=
5239
for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
5241
@ @<Finish the extensions@>=
5242
terminate_font_manager;
5243
for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
5245
@ @<Implement \.{\\XeTeXpicfile}@>=
5246
if abs(mode)=mmode then report_illegal_case
5247
else load_picture(false)
5249
@ @<Implement \.{\\XeTeXpdffile}@>=
5250
if abs(mode)=mmode then report_illegal_case
5251
else load_picture(true)
5253
@ @<Implement \.{\\XeTeXglyph}@>=
5255
if abs(mode)=vmode then begin
5258
end else if abs(mode)=mmode then report_illegal_case
5260
if is_native_font(cur_font) then begin
5261
new_whatsit(glyph_node,glyph_node_size);
5263
if (cur_val<0)or(cur_val>65535) then
5264
begin print_err("Bad glyph number");
5265
help2("A glyph number must be between 0 and 65535.")@/
5266
("I changed this one to zero."); int_error(cur_val); cur_val:=0;
5268
native_font(tail):=cur_font;
5269
native_glyph(tail):=cur_val;
5270
set_native_glyph_metrics(tail, XeTeX_use_glyph_metrics);
5271
end else not_native_font_error(extension, glyph_code, cur_font);
5275
@ Load a picture file and handle following keywords.
5277
@d calc_min_and_max==
5283
for i := 0 to 3 do begin
5284
if xCoord(corners[i]) < xmin then xmin := xCoord(corners[i]);
5285
if xCoord(corners[i]) > xmax then xmax := xCoord(corners[i]);
5286
if yCoord(corners[i]) < ymin then ymin := yCoord(corners[i]);
5287
if yCoord(corners[i]) > ymax then ymax := yCoord(corners[i]);
5293
transform_point(address_of(corners[i]), address_of(t2))
5295
@d do_size_requests==begin
5296
{ calculate current width and height }
5298
if x_size_req = 0.0 then begin
5299
make_scale(address_of(t2), y_size_req / (ymax - ymin), y_size_req / (ymax - ymin));
5300
end else if y_size_req = 0.0 then begin
5301
make_scale(address_of(t2), x_size_req / (xmax - xmin), x_size_req / (xmax - xmin));
5303
make_scale(address_of(t2), x_size_req / (xmax - xmin), y_size_req / (ymax - ymin));
5308
transform_concat(address_of(t), address_of(t2));
5311
@<Declare procedures needed in |do_extension|@>=
5312
procedure load_picture(@!is_pdf:boolean);
5317
corners: array[0..3] of real_point;
5318
x_size_req,y_size_req: real;
5319
check_keywords: boolean;
5320
x_size, y_size: real;
5321
xmin,xmax,ymin,ymax: real;
5324
pdf_box_type: integer;
5327
{ scan the filename and pack into name_of_file }
5333
if is_pdf then begin
5334
if scan_keyword("page") then begin
5338
pdf_box_type := pdfbox_crop;
5339
if scan_keyword("crop") then do_nothing
5340
else if scan_keyword("media") then pdf_box_type := pdfbox_media
5341
else if scan_keyword("bleed") then pdf_box_type := pdfbox_bleed
5342
else if scan_keyword("trim") then pdf_box_type := pdfbox_trim
5343
else if scan_keyword("art") then pdf_box_type := pdfbox_art;
5346
{ access the picture file and check its size }
5347
result := find_pic_file(address_of(pic_path), address_of(bounds), pdf_box_type, page);
5349
setPoint(corners[0], xField(bounds) * 72.27 / 72.0, yField(bounds) * 72.27 / 72.0);
5350
setPoint(corners[1], xField(corners[0]), (yField(bounds) + htField(bounds)) * 72.27 / 72.0);
5351
setPoint(corners[2], (xField(bounds) + wdField(bounds)) * 72.27 / 72.0, yField(corners[1]));
5352
setPoint(corners[3], xField(corners[2]), yField(corners[0]));
5357
{ look for any scaling requests for this picture }
5358
make_identity(address_of(t));
5360
check_keywords := true;
5361
while check_keywords do begin
5362
if scan_keyword("scaled") then begin
5364
if (x_size_req = 0.0) and (y_size_req = 0.0) then begin
5365
make_scale(address_of(t2), float(cur_val) / 1000.0, float(cur_val) / 1000.0);
5367
transform_concat(address_of(t), address_of(t2));
5369
end else if scan_keyword("xscaled") then begin
5371
if (x_size_req = 0.0) and (y_size_req = 0.0) then begin
5372
make_scale(address_of(t2), float(cur_val) / 1000.0, 1.0);
5374
transform_concat(address_of(t), address_of(t2));
5376
end else if scan_keyword("yscaled") then begin
5378
if (x_size_req = 0.0) and (y_size_req = 0.0) then begin
5379
make_scale(address_of(t2), 1.0, float(cur_val) / 1000.0);
5381
transform_concat(address_of(t), address_of(t2));
5383
end else if scan_keyword("width") then begin
5385
if cur_val <= 0 then begin
5386
print_err("Improper image ");
5388
print_scaled(cur_val);
5389
print("pt) will be ignored");
5390
help2("I can't scale images to zero or negative sizes, ")
5391
("so I'm ignoring this.");
5394
x_size_req := Fix2X(cur_val);
5395
end else if scan_keyword("height") then begin
5397
if cur_val <= 0 then begin
5398
print_err("Improper image ");
5400
print_scaled(cur_val);
5401
print("pt) will be ignored");
5402
help2("I can't scale images to zero or negative sizes, ")
5403
("so I'm ignoring this.");
5406
y_size_req := Fix2X(cur_val);
5407
end else if scan_keyword("rotated") then begin
5409
if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests;
5410
make_rotation(address_of(t2), Fix2X(cur_val) * 3.141592653589793 / 180.0);
5413
setPoint(corners[0], xmin, ymin);
5414
setPoint(corners[1], xmin, ymax);
5415
setPoint(corners[2], xmax, ymax);
5416
setPoint(corners[3], xmax, ymin);
5417
transform_concat(address_of(t), address_of(t2));
5419
check_keywords := false;
5422
if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests;
5425
make_translation(address_of(t2), -xmin, -ymin);
5426
transform_concat(address_of(t), address_of(t2));
5428
if result = 0 then begin
5430
new_whatsit(pic_node, pic_node_size + (strlen(pic_path) + sizeof(memory_word) - 1) div sizeof(memory_word));
5431
if is_pdf then begin
5432
subtype(tail) := pdf_node;
5433
pic_box_type(tail) := pdf_box_type;
5435
pic_path_length(tail) := strlen(pic_path);
5436
pic_page(tail) := page;
5438
width(tail) := X2Fix(xmax - xmin);
5439
height(tail) := X2Fix(ymax - ymin);
5442
pic_transform1(tail) := X2Fix(aField(t));
5443
pic_transform2(tail) := X2Fix(bField(t));
5444
pic_transform3(tail) := X2Fix(cField(t));
5445
pic_transform4(tail) := X2Fix(dField(t));
5446
pic_transform5(tail) := X2Fix(txField(t));
5447
pic_transform6(tail) := X2Fix(tyField(t));
5449
memcpy(address_of(mem[tail + pic_node_size]), pic_path, strlen(pic_path));
5450
libc_free(pic_path);
5454
print_err("Unable to load picture or PDF file '");
5455
print_file_name(cur_name,cur_area,cur_ext); print("'");
5456
if result = -43 then begin { Mac OS file not found error }
5457
help2("The requested image couldn't be read because ")
5458
("the file was not found.");
5460
else begin { otherwise assume GraphicImport failed }
5461
help2("The requested image couldn't be read because ")
5462
("it was not a recognized image format.");
5470
@ @<Implement \.{\\XeTeXinputencoding}@>=
5472
{ scan a filename-like arg for the input encoding }
5475
{ convert it to "mode" and "encoding" values, and apply to the current input file }
5476
i := get_encoding_mode_and_info(address_of(j));
5477
if i = XeTeX_input_mode_auto then begin
5478
print_err("Encoding mode `auto' is not valid for \XeTeXinputencoding.");
5479
help2("You can't use `auto' encoding here, only for \XeTeXdefaultencoding. ")
5480
("I'll ignore this and leave the current encoding unchanged.");
5482
end else set_input_file_encoding(input_file[in_open], i, j);
5485
@ @<Implement \.{\\XeTeXdefaultencoding}@>=
5487
{ scan a filename-like arg for the input encoding }
5490
{ convert it to "mode" and "encoding" values, and store them as defaults for new input files }
5491
XeTeX_default_input_mode := get_encoding_mode_and_info(address_of(j));
5492
XeTeX_default_input_encoding := j;
5495
@ @<Implement \.{\\XeTeXlinebreaklocale}@>=
5497
{ scan a filename-like arg for the locale name }
5499
if length(cur_name) = 0 then XeTeX_linebreak_locale := 0
5500
else XeTeX_linebreak_locale := cur_name; { we ignore the area and extension! }
5504
@!pdf_last_x_pos: integer;
5505
@!pdf_last_y_pos: integer;
5507
@ @<Implement \.{\\pdfsavepos}@>=
5509
new_whatsit(pdf_save_pos_node, small_node_size);
5515
@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
5517
@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
5519
@d XeTeX_version_code=XeTeX_int {code for \.{\\XeTeXversion}}
5521
{ these are also in xetexmac.c and must correspond! }
5522
@d XeTeX_count_glyphs_code=XeTeX_int+1
5524
@d XeTeX_count_variations_code=XeTeX_int+2
5525
@d XeTeX_variation_code=XeTeX_int+3
5526
@d XeTeX_find_variation_by_name_code=XeTeX_int+4
5527
@d XeTeX_variation_min_code=XeTeX_int+5
5528
@d XeTeX_variation_max_code=XeTeX_int+6
5529
@d XeTeX_variation_default_code=XeTeX_int+7
5531
@d XeTeX_count_features_code=XeTeX_int+8
5532
@d XeTeX_feature_code_code=XeTeX_int+9
5533
@d XeTeX_find_feature_by_name_code=XeTeX_int+10
5534
@d XeTeX_is_exclusive_feature_code=XeTeX_int+11
5535
@d XeTeX_count_selectors_code=XeTeX_int+12
5536
@d XeTeX_selector_code_code=XeTeX_int+13
5537
@d XeTeX_find_selector_by_name_code=XeTeX_int+14
5538
@d XeTeX_is_default_selector_code=XeTeX_int+15
5540
@d XeTeX_OT_count_scripts_code=XeTeX_int+16
5541
@d XeTeX_OT_count_languages_code=XeTeX_int+17
5542
@d XeTeX_OT_count_features_code=XeTeX_int+18
5543
@d XeTeX_OT_script_code=XeTeX_int+19
5544
@d XeTeX_OT_language_code=XeTeX_int+20
5545
@d XeTeX_OT_feature_code=XeTeX_int+21
5547
@d XeTeX_map_char_to_glyph_code=XeTeX_int+22
5548
@d XeTeX_glyph_index_code=XeTeX_int+23
5549
@d XeTeX_font_type_code=XeTeX_int+24
5551
@d XeTeX_first_char_code=XeTeX_int+25
5552
@d XeTeX_last_char_code=XeTeX_int+26
5554
@d pdf_last_x_pos_code = XeTeX_int+27
5555
@d pdf_last_y_pos_code = XeTeX_int+28
5557
{ NB: must update eTeX_dim when items are added here! }
5561
@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
5563
@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
5565
primitive("XeTeXversion",last_item,XeTeX_version_code);
5566
@!@:XeTeX_version_}{\.{\\XeTeXversion} primitive@>
5567
primitive("XeTeXrevision",convert,XeTeX_revision_code);@/
5568
@!@:XeTeXrevision_}{\.{\\XeTeXrevision} primitive@>
5570
primitive("XeTeXcountglyphs",last_item,XeTeX_count_glyphs_code);
5572
primitive("XeTeXcountvariations",last_item,XeTeX_count_variations_code);
5573
primitive("XeTeXvariation",last_item,XeTeX_variation_code);
5574
primitive("XeTeXfindvariationbyname",last_item,XeTeX_find_variation_by_name_code);
5575
primitive("XeTeXvariationmin",last_item,XeTeX_variation_min_code);
5576
primitive("XeTeXvariationmax",last_item,XeTeX_variation_max_code);
5577
primitive("XeTeXvariationdefault",last_item,XeTeX_variation_default_code);
5579
primitive("XeTeXcountfeatures",last_item,XeTeX_count_features_code);
5580
primitive("XeTeXfeaturecode",last_item,XeTeX_feature_code_code);
5581
primitive("XeTeXfindfeaturebyname",last_item,XeTeX_find_feature_by_name_code);
5582
primitive("XeTeXisexclusivefeature",last_item,XeTeX_is_exclusive_feature_code);
5583
primitive("XeTeXcountselectors",last_item,XeTeX_count_selectors_code);
5584
primitive("XeTeXselectorcode",last_item,XeTeX_selector_code_code);
5585
primitive("XeTeXfindselectorbyname",last_item,XeTeX_find_selector_by_name_code);
5586
primitive("XeTeXisdefaultselector",last_item,XeTeX_is_default_selector_code);
5588
primitive("XeTeXvariationname",convert,XeTeX_variation_name_code);
5589
primitive("XeTeXfeaturename",convert,XeTeX_feature_name_code);
5590
primitive("XeTeXselectorname",convert,XeTeX_selector_name_code);
5592
primitive("XeTeXOTcountscripts",last_item,XeTeX_OT_count_scripts_code);
5593
primitive("XeTeXOTcountlanguages",last_item,XeTeX_OT_count_languages_code);
5594
primitive("XeTeXOTcountfeatures",last_item,XeTeX_OT_count_features_code);
5595
primitive("XeTeXOTscripttag",last_item,XeTeX_OT_script_code);
5596
primitive("XeTeXOTlanguagetag",last_item,XeTeX_OT_language_code);
5597
primitive("XeTeXOTfeaturetag",last_item,XeTeX_OT_feature_code);
5599
primitive("XeTeXcharglyph", last_item, XeTeX_map_char_to_glyph_code);
5600
primitive("XeTeXglyphindex", last_item, XeTeX_glyph_index_code);
5602
primitive("XeTeXglyphname",convert,XeTeX_glyph_name_code);
5604
primitive("XeTeXfonttype", last_item, XeTeX_font_type_code);
5606
primitive("XeTeXfirstfontchar", last_item, XeTeX_first_char_code);
5607
primitive("XeTeXlastfontchar", last_item, XeTeX_last_char_code);
5609
primitive("pdflastxpos",last_item,pdf_last_x_pos_code);
5610
primitive("pdflastypos",last_item,pdf_last_y_pos_code);
5614
eTeX_version_code: print_esc("eTeXversion");
5616
eTeX_version_code: print_esc("eTeXversion");
5617
XeTeX_version_code: print_esc("XeTeXversion");
5619
XeTeX_count_glyphs_code: print_esc("XeTeXcountglyphs");
5621
XeTeX_count_variations_code: print_esc("XeTeXcountvariations");
5622
XeTeX_variation_code: print_esc("XeTeXvariation");
5623
XeTeX_find_variation_by_name_code: print_esc("XeTeXfindvariationbyname");
5624
XeTeX_variation_min_code: print_esc("XeTeXvariationmin");
5625
XeTeX_variation_max_code: print_esc("XeTeXvariationmax");
5626
XeTeX_variation_default_code: print_esc("XeTeXvariationdefault");
5628
XeTeX_count_features_code: print_esc("XeTeXcountfeatures");
5629
XeTeX_feature_code_code: print_esc("XeTeXfeaturecode");
5630
XeTeX_find_feature_by_name_code: print_esc("XeTeXfindfeaturebyname");
5631
XeTeX_is_exclusive_feature_code: print_esc("XeTeXisexclusivefeature");
5632
XeTeX_count_selectors_code: print_esc("XeTeXcountselectors");
5633
XeTeX_selector_code_code: print_esc("XeTeXselectorcode");
5634
XeTeX_find_selector_by_name_code: print_esc("XeTeXfindselectorbyname");
5635
XeTeX_is_default_selector_code: print_esc("XeTeXisdefaultselector");
5637
XeTeX_OT_count_scripts_code: print_esc("XeTeXOTcountscripts");
5638
XeTeX_OT_count_languages_code: print_esc("XeTeXOTcountlanguages");
5639
XeTeX_OT_count_features_code: print_esc("XeTeXOTcountfeatures");
5640
XeTeX_OT_script_code: print_esc("XeTeXOTscripttag");
5641
XeTeX_OT_language_code: print_esc("XeTeXOTlanguagetag");
5642
XeTeX_OT_feature_code: print_esc("XeTeXOTfeaturetag");
5644
XeTeX_map_char_to_glyph_code: print_esc("XeTeXcharglyph");
5645
XeTeX_glyph_index_code: print_esc("XeTeXglyphindex");
5647
XeTeX_font_type_code: print_esc("XeTeXfonttype");
5649
XeTeX_first_char_code: print_esc("XeTeXfirstfontchar");
5650
XeTeX_last_char_code: print_esc("XeTeXlastfontchar");
5652
pdf_last_x_pos_code: print_esc("pdflastxpos");
5653
pdf_last_y_pos_code: print_esc("pdflastypos");
5657
eTeX_version_code: cur_val:=eTeX_version;
5659
eTeX_version_code: cur_val:=eTeX_version;
5660
XeTeX_version_code: cur_val:=XeTeX_version;
5662
XeTeX_count_glyphs_code:
5664
scan_font_ident; n:=cur_val;
5665
if is_atsu_font(n) then
5666
cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n])
5667
else if is_ot_font(n) then
5668
cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n])
5673
XeTeX_count_variations_code,
5674
XeTeX_count_features_code:
5676
scan_font_ident; n:=cur_val;
5677
if is_atsu_font(n) then
5678
cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n])
5684
XeTeX_variation_code,
5685
XeTeX_variation_min_code,
5686
XeTeX_variation_max_code,
5687
XeTeX_variation_default_code,
5688
XeTeX_feature_code_code,
5689
XeTeX_is_exclusive_feature_code,
5690
XeTeX_count_selectors_code:
5692
scan_font_ident; n:=cur_val;
5693
if is_atsu_font(n) then begin
5694
scan_int; k:=cur_val;
5695
cur_val:=atsu_font_get_1(m - XeTeX_int, font_layout_engine[n], k);
5697
not_atsu_font_error(last_item, m, n); cur_val:=-1;
5701
XeTeX_selector_code_code,
5702
XeTeX_is_default_selector_code:
5704
scan_font_ident; n:=cur_val;
5705
if is_atsu_font(n) then begin
5706
scan_int; k:=cur_val; scan_int;
5707
cur_val:=atsu_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val);
5709
not_atsu_font_error(last_item, m, n); cur_val:=-1;
5713
XeTeX_find_variation_by_name_code,
5714
XeTeX_find_feature_by_name_code:
5716
scan_font_ident; n:=cur_val;
5717
if is_atsu_font(n) then begin
5719
cur_val:=atsu_font_get_named(m - XeTeX_int, font_layout_engine[n]);
5721
not_atsu_font_error(last_item, m, n); cur_val:=-1;
5725
XeTeX_find_selector_by_name_code:
5727
scan_font_ident; n:=cur_val;
5728
if is_atsu_font(n) then begin
5729
scan_int; k:=cur_val; scan_and_pack_name;
5730
cur_val:=atsu_font_get_named_1(m - XeTeX_int, font_layout_engine[n], k);
5732
not_atsu_font_error(last_item, m, n); cur_val:=-1;
5736
XeTeX_OT_count_scripts_code:
5738
scan_font_ident; n:=cur_val;
5739
if is_ot_font(n) then
5740
cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n])
5743
not_ot_font_error(last_item, m, n); cur_val:=-1;
5749
XeTeX_OT_count_languages_code,
5750
XeTeX_OT_script_code:
5752
scan_font_ident; n:=cur_val;
5753
if is_ot_font(n) then begin
5754
scan_int; k:=cur_val;
5755
cur_val:=ot_font_get_1(m - XeTeX_int, font_layout_engine[n], k);
5757
not_ot_font_error(last_item, m, n); cur_val:=-1;
5761
XeTeX_OT_count_features_code,
5762
XeTeX_OT_language_code:
5764
scan_font_ident; n:=cur_val;
5765
if is_ot_font(n) then begin
5766
scan_int; k:=cur_val; scan_int;
5767
cur_val:=ot_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val);
5769
not_ot_font_error(last_item, m, n); cur_val:=-1;
5773
XeTeX_OT_feature_code:
5775
scan_font_ident; n:=cur_val;
5776
if is_ot_font(n) then begin
5777
scan_int; k:=cur_val; scan_int; kk:=cur_val; scan_int;
5778
cur_val:=ot_font_get_3(m - XeTeX_int, font_layout_engine[n], k, kk, cur_val);
5780
not_ot_font_error(last_item, m, n); cur_val:=-1;
5784
XeTeX_map_char_to_glyph_code:
5786
if is_native_font(cur_font) then begin
5787
scan_int; n:=cur_val; cur_val:=map_char_to_glyph(cur_font, n)
5789
not_native_font_error(last_item, m, cur_font); cur_val:=0
5793
XeTeX_glyph_index_code:
5795
if is_native_font(cur_font) then begin
5797
cur_val:=map_glyph_to_index(cur_font)
5799
not_native_font_error(last_item, m, cur_font); cur_val:=0
5803
XeTeX_font_type_code:
5805
scan_font_ident; n:=cur_val;
5806
if is_atsu_font(n) then cur_val:=1
5808
if is_ot_font(n) then cur_val:=2
5813
XeTeX_first_char_code,XeTeX_last_char_code:
5815
scan_font_ident; n:=cur_val;
5816
if is_native_font(n) then
5817
cur_val:=get_font_char_range(n, m = XeTeX_first_char_code)
5819
if m = XeTeX_first_char_code then cur_val:=font_bc[n]
5820
else cur_val:=font_ec[n];
5824
pdf_last_x_pos_code: cur_val := pdf_last_x_pos;
5825
pdf_last_y_pos_code: cur_val := pdf_last_y_pos;
5827
@ Slip in an extra procedure here and there....
5830
procedure scan_and_pack_name; forward;
5832
@ @<Declare procedures needed in |do_extension|@>=
5833
procedure scan_and_pack_name;
5835
scan_file_name; pack_cur_name;
5838
@ @<Declare the procedure called |print_cmd_chr|@>=
5839
procedure not_atsu_font_error(cmd, c: integer; f: integer);
5841
print_err("Cannot use "); print_cmd_chr(cmd, c);
5842
print(" with "); print(font_name[f]);
5843
print("; not an AAT font");
5847
procedure not_ot_font_error(cmd, c: integer; f: integer);
5849
print_err("Cannot use "); print_cmd_chr(cmd, c);
5850
print(" with "); print(font_name[f]);
5851
print("; not an OpenType Layout font");
5855
procedure not_native_font_error(cmd, c: integer; f: integer);
5857
print_err("Cannot use "); print_cmd_chr(cmd, c);
5858
print(" with "); print(font_name[f]);
5859
print("; not a native platform font");
5863
@ @<Cases of |convert| for |print_cmd_chr|@>=
5864
eTeX_revision_code: print_esc("eTeXrevision");
5865
XeTeX_revision_code: print_esc("XeTeXrevision");
5867
XeTeX_variation_name_code: print_esc("XeTeXvariationname");
5868
XeTeX_feature_name_code: print_esc("XeTeXfeaturename");
5869
XeTeX_selector_name_code: print_esc("XeTeXselectorname");
5870
XeTeX_glyph_name_code: print_esc("XeTeXglyphname");
5872
@ @<Cases of `Scan the argument for command |c|'@>=
5873
eTeX_revision_code: do_nothing;
5874
XeTeX_revision_code: do_nothing;
5876
XeTeX_variation_name_code,
5877
XeTeX_feature_name_code:
5879
scan_font_ident; fnt:=cur_val;
5880
if is_atsu_font(fnt) then begin
5881
scan_int; arg1:=cur_val; arg2:=0;
5883
not_atsu_font_error(convert, c, fnt);
5886
XeTeX_selector_name_code:
5888
scan_font_ident; fnt:=cur_val;
5889
if is_atsu_font(fnt) then begin
5890
scan_int; arg1:=cur_val; scan_int; arg2:=cur_val;
5892
not_atsu_font_error(convert, c, fnt);
5895
XeTeX_glyph_name_code:
5897
scan_font_ident; fnt:=cur_val;
5898
if is_native_font(fnt) then begin
5899
scan_int; arg1:=cur_val;
5901
not_native_font_error(convert, c, fnt);
5904
@ @<Cases of `Print the result of command |c|'@>=
5905
eTeX_revision_code: print(eTeX_revision);
5906
XeTeX_revision_code: print(XeTeX_revision);
5908
XeTeX_variation_name_code,
5909
XeTeX_feature_name_code,
5910
XeTeX_selector_name_code:
5911
if is_atsu_font(fnt) then
5912
atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2);
5914
XeTeX_glyph_name_code:
5915
if is_native_font(fnt) then print_glyph_name(fnt, arg1);
5922
font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num;
5923
if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then
5924
begin i:=char_info(q)(qi(cur_val));
5926
font_char_wd_code: cur_val:=char_width(q)(i);
5927
font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
5928
font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
5929
font_char_ic_code: cur_val:=char_italic(q)(i);
5930
end; {there are no other cases}
5938
font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_usv_num;
5939
if is_native_font(q) then begin
5941
font_char_wd_code: cur_val := getnativecharwd(q, cur_val);
5942
font_char_ht_code: cur_val := getnativecharht(q, cur_val);
5943
font_char_dp_code: cur_val := getnativechardp(q, cur_val);
5944
font_char_ic_code: cur_val := getnativecharic(q, cur_val);
5945
end; {there are no other cases}
5947
if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then
5948
begin i:=char_info(q)(qi(cur_val));
5950
font_char_wd_code: cur_val:=char_width(q)(i);
5951
font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
5952
font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
5953
font_char_ic_code: cur_val:=char_italic(q)(i);
5954
end; {there are no other cases}
5962
@d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?}
5964
@d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?}
5966
@d XeTeX_dash_break_state == eTeX_state(XeTeX_dash_break_code)
5967
@d XeTeX_dash_break_en == (XeTeX_dash_break_state>0)
5969
@d XeTeX_default_input_mode == eTeX_state(XeTeX_default_input_mode_code)
5970
@d XeTeX_default_input_encoding == eTeX_state(XeTeX_default_input_encoding_code)
5974
eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate");
5976
eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate");
5977
eTeX_state_code+XeTeX_dash_break_code:print_esc("XeTeXdashbreakstate");
5981
primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code);
5982
@!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@>
5984
primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code);
5985
@!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@>
5987
primitive("XeTeXdashbreakstate",assign_int,eTeX_state_base+XeTeX_dash_break_code);
5988
@!@:XeTeX_dash_break_state_}{\.{\\XeTeX_dash_break_state} primitive@>
5990
primitive("XeTeXinputencoding",extension,XeTeX_input_encoding_extension_code);
5991
primitive("XeTeXdefaultencoding",extension,XeTeX_default_encoding_extension_code);
5995
@ Here we compute the effective width of a glue node as in |hlist_out|.
5997
@<Cases of |reverse|...@>=
5998
glue_node: begin round_glue;
5999
@<Handle a glue node for mixed...@>;
6002
@ Need to measure native_word and picture nodes when reversing!
6003
@<Cases of |reverse|...@>=
6005
if (subtype(p)=native_word_node)
6006
or (subtype(p)=glyph_node)
6007
or (subtype(p)=pic_node)
6008
or (subtype(p)=pdf_node)
6014
@ Here we compute the effective width of a glue node as in |hlist_out|.
6018
str_pool[pool_ptr]:=si(" "); l:=str_start[s];
6020
str_pool[pool_ptr]:=si(" "); l:=str_start_macro(s);
6024
if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num;
6025
if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then
6026
b:=char_exists(char_info(n)(qi(cur_val)))
6030
if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num;
6031
if is_native_font(n) then
6032
b := (map_char_to_glyph(n, cur_val) > 0)
6034
if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then
6035
b:=char_exists(char_info(n)(qi(cur_val)))
6042
for c := str_start[text(h)] to str_start[text(h) + 1] - 1
6044
for c := str_start_macro(text(h)) to str_start_macro(text(h) + 1) - 1
6048
while s>255 do {first 256 strings depend on implementation!!}
6050
while s>65535 do {first 64K strings don't really exist in the pool!}
6054
@!mltex_enabled_p:boolean; {enable character substitution}
6056
@!mltex_enabled_p:boolean; {enable character substitution}
6057
@!native_font_type_flag:integer; {used by XeTeX font loading code to record which font technology was used}
6061
effective_char_info:=null_character;
6064
effective_char_info:=null_character;
6067
{ the following procedure has been moved so that new_native_character can call it }
6069
procedure char_warning(@!f:internal_font_number;@!c:integer);
6070
var old_setting: integer; {saved value of |tracing_online|}
6071
begin if tracing_lost_chars>0 then
6072
begin old_setting:=tracing_online;
6073
if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
6074
begin begin_diagnostic;
6075
print_nl("Missing character: There is no ");
6076
@.Missing character@>
6077
if c < @"10000 then print_ASCII(c)
6078
else begin { non-Plane 0 Unicodes can't be sent through print_ASCII }
6079
print("character number ");
6083
slow_print(font_name[f]); print_char("!"); end_diagnostic(false);
6085
tracing_online:=old_setting;
6089
{ additional functions for native font support }
6091
function new_native_word_node(@!f:internal_font_number;@!n:integer):pointer;
6092
{ note that this function creates the node, but does not actually set its metrics;
6093
call set_native_metrics(node) if that is required! }
6098
l := native_node_size + (n * sizeof(UTF16_code) + sizeof(memory_word) - 1) div sizeof(memory_word);
6101
type(q) := whatsit_node;
6102
subtype(q) := native_word_node;
6104
native_size(q) := l;
6105
native_font(q) := f;
6106
native_length(q) := n;
6108
native_glyph_count(q) := 0;
6109
native_glyph_info_ptr(q) := 0;
6111
new_native_word_node := q;
6114
function new_native_character(@!f:internal_font_number;@!c:UnicodeScalar):pointer;
6119
if font_mapping[f] <> 0 then begin
6120
if c > @"FFFF then begin
6122
append_char((c - @"10000) div 1024 + @"D800);
6123
append_char((c - @"10000) mod 1024 + @"DC00);
6129
len := apply_mapping(font_mapping[f], address_of(str_pool[str_start_macro(str_ptr)]), cur_length);
6130
pool_ptr := str_start_macro(str_ptr); { flush the string, as we'll be using the mapped text instead }
6133
while i < len do begin
6134
if (mapped_text[i] >= @"D800) and (mapped_text[i] < @"DC00) then begin
6135
c := (mapped_text[i] - @"D800) * 1024 + mapped_text[i+1] - @"DC00 + @"10000;
6136
if map_char_to_glyph(f, c) = 0 then begin
6142
if map_char_to_glyph(f, mapped_text[i]) = 0 then begin
6143
char_warning(f, mapped_text[i]);
6149
p := new_native_word_node(f, len);
6150
for i := 0 to len-1 do begin
6151
set_native_char(p, i, mapped_text[i]);
6155
if tracing_lost_chars > 0 then
6156
if map_char_to_glyph(f, c) = 0 then begin
6160
p := get_node(native_node_size + 1);
6161
type(p) := whatsit_node;
6162
subtype(p) := native_word_node;
6164
native_size(p) := native_node_size + 1;
6165
native_glyph_count(p) := 0;
6166
native_glyph_info_ptr(p) := 0;
6167
native_font(p) := f;
6169
if c > @"FFFF then begin
6170
native_length(p) := 2;
6171
set_native_char(p, 0, (c - @"10000) div 1024 + @"D800);
6172
set_native_char(p, 1, (c - @"10000) mod 1024 + @"DC00);
6175
native_length(p) := 1;
6176
set_native_char(p, 0, c);
6180
set_native_metrics(p, XeTeX_use_glyph_metrics);
6182
new_native_character := p;
6185
procedure font_feature_warning(featureNameP:void_pointer; featLen:integer;
6186
settingNameP:void_pointer; setLen:integer);
6191
print_nl("Unknown ");
6192
if setLen > 0 then begin
6193
print("selector `");
6194
print_utf8_str(settingNameP, setLen);
6198
print_utf8_str(featureNameP, featLen);
6199
print("' in font `");
6201
while ord(name_of_file[i]) <> 0 do begin
6202
print_visible_char(name_of_file[i]); { this is already UTF-8 }
6206
end_diagnostic(false);
6209
procedure font_mapping_warning(mappingNameP:void_pointer; mappingNameLen:integer);
6214
print_nl("Font mapping `");
6215
print_utf8_str(mappingNameP, mappingNameLen);
6216
print("' for font `");
6218
while ord(name_of_file[i]) <> 0 do begin
6219
print_visible_char(name_of_file[i]); { this is already UTF-8 }
6222
print("' not found.");
6223
end_diagnostic(false);
6226
function load_native_font(u: pointer; nom, aire:str_number; s: scaled): internal_font_number;
6231
font_engine: void_pointer; {really an ATSUStyle or XeTeXLayoutEngine}
6232
actual_size: scaled; {|s| converted to real size, if it was negative}
6233
p: pointer; {for temporary |native_char| node we'll create}
6234
ascent, descent, font_slant, x_ht, cap_ht: scaled;
6235
f: internal_font_number;
6236
full_name: str_number;
6238
{ on entry here, the full name is packed into name_of_file in UTF8 form }
6240
load_native_font := null_font;
6242
if (s < 0) then actual_size := -s * unity div 100 else actual_size := s;
6243
font_engine := find_native_font(name_of_file + 1, actual_size);
6244
if font_engine = 0 then goto done;
6246
{ look again to see if the font is already loaded, now that we know its canonical name }
6247
str_room(name_length);
6248
for k := 1 to name_length do
6249
append_char(name_of_file[k]);
6250
full_name := make_string; { not slow_make_string because we'll flush it if the font was already loaded }
6252
for f:=font_base+1 to font_ptr do
6253
if (font_area[f] = native_font_type_flag) and str_eq_str(font_name[f], full_name) and (font_size[f] = actual_size) then begin
6254
release_font_engine(font_engine, native_font_type_flag);
6256
load_native_font := f;
6260
if (font_ptr = font_max) or (fmem_ptr + 8 > font_mem_size) then begin
6261
@<Apologize for not loading the font, |goto done|@>;
6264
{ we've found a valid installed font, and have room }
6266
font_area[font_ptr] := native_font_type_flag; { set by find_native_font to either aat_font_flag or ot_font_flag }
6268
{ store the canonical name }
6269
font_name[font_ptr] := full_name;
6271
font_check[font_ptr].b0 := 0;
6272
font_check[font_ptr].b1 := 0;
6273
font_check[font_ptr].b2 := 0;
6274
font_check[font_ptr].b3 := 0;
6275
font_glue[font_ptr] := null;
6276
font_dsize[font_ptr] := 10 * unity;
6277
font_size[font_ptr] := actual_size;
6279
if (native_font_type_flag = aat_font_flag) then begin
6280
atsu_get_font_metrics(font_engine, address_of(ascent), address_of(descent),
6281
address_of(x_ht), address_of(cap_ht), address_of(font_slant))
6283
ot_get_font_metrics(font_engine, address_of(ascent), address_of(descent),
6284
address_of(x_ht), address_of(cap_ht), address_of(font_slant));
6287
height_base[font_ptr] := ascent;
6288
depth_base[font_ptr] := -descent;
6290
font_params[font_ptr] := 8; { we add an extra \fontdimen: #8 -> cap_height }
6291
font_bc[font_ptr] := 0;
6292
font_ec[font_ptr] := 65535;
6293
font_used[font_ptr] := false;
6294
hyphen_char[font_ptr] := default_hyphen_char;
6295
skew_char[font_ptr] := default_skew_char;
6296
param_base[font_ptr] := fmem_ptr-1;
6298
font_layout_engine[font_ptr] := font_engine;
6299
font_mapping[font_ptr] := 0; { don't use the mapping, if any, when measuring space here }
6300
font_letter_space[font_ptr] := loaded_font_letter_space;
6302
{measure the width of the space character and set up font parameters}
6303
p := new_native_character(font_ptr, " ");
6304
s := width(p) + loaded_font_letter_space;
6305
free_node(p, native_size(p));
6307
font_info[fmem_ptr].sc := font_slant; {slant}
6309
font_info[fmem_ptr].sc := s; {space = width of space character}
6311
font_info[fmem_ptr].sc := s div 2; {space_stretch = 1/2 * space}
6313
font_info[fmem_ptr].sc := s div 3; {space_shrink = 1/3 * space}
6315
font_info[fmem_ptr].sc := x_ht; {x_height}
6317
font_info[fmem_ptr].sc := font_size[font_ptr]; {quad = font size}
6319
font_info[fmem_ptr].sc := s div 3; {extra_space = 1/3 * space}
6321
font_info[fmem_ptr].sc := cap_ht; {cap_height}
6324
font_mapping[font_ptr] := loaded_font_mapping;
6325
font_flags[font_ptr] := loaded_font_flags;
6327
load_native_font := font_ptr;
6331
procedure do_locale_linebreaks(s: pointer; len: integer);
6333
offs, prevOffs, i: integer;
6334
use_penalty, use_skip: boolean;
6336
if XeTeX_linebreak_locale = 0 then begin
6337
link(tail) := new_native_word_node(main_f, len);
6339
for i := 0 to len - 1 do
6340
set_native_char(tail, i, str_pool[s + i]);
6341
set_native_metrics(tail, XeTeX_use_glyph_metrics);
6343
use_skip := XeTeX_linebreak_skip <> zero_glue;
6344
use_penalty := XeTeX_linebreak_penalty <> 0 or not use_skip;
6345
linebreak_start(XeTeX_linebreak_locale, address_of(str_pool[s]), len);
6349
offs := linebreak_next;
6350
if offs > 0 then begin
6351
if prevOffs <> 0 then begin
6353
tail_append(new_penalty(XeTeX_linebreak_penalty));
6355
tail_append(new_param_glue(XeTeX_linebreak_skip_code));
6357
link(tail) := new_native_word_node(main_f, offs - prevOffs);
6359
for i := prevOffs to offs - 1 do
6360
set_native_char(tail, i - prevOffs, str_pool[s + i]);
6361
set_native_metrics(tail, XeTeX_use_glyph_metrics);
added
removed
build/source/texk/web2c/xetexdir/xetex-new.ch
