COMPILATION LISTING OF SEGMENT comp_measure_ Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/23/85 1006.2 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * Copyright, (C) Honeywell Information Systems Inc., 1980 * 6* * * 7* * * 8* *********************************************************** */ 9 10 /* compose subroutine to measure string lengths in millipoints */ 11 12 /* format: style2,ind2,ll79,dclind4,idind15,comcol41,linecom */ 13 14 comp_measure_: 15 proc (a_str, afnt_ptr, fill, art, quad, a_lmeas, meas1_ptr, meas2_ptr, 16 info_ptr); 17 18 /* PARAMETERS */ 19 20 dcl a_str char (1020) var; /* string to be measured - IN */ 21 dcl afnt_ptr ptr; /* font description - IN */ 22 dcl fill bit (1); /* 0 = simple measuring - IN */ 23 /* 1 = measuring filled text */ 24 dcl art bit (1); /* 1 = line may have art - IN */ 25 dcl quad bit (6); /* line set control */ 26 dcl a_lmeas fixed bin (31); /* measure of target line - IN */ 27 /* if a_lmeas is 0, then then entire */ 28 /* string is to be measured */ 29 dcl meas1_ptr ptr; /* str that fits - IN */ 30 dcl meas2_ptr ptr; /* overflow str - IN */ 31 dcl info_ptr ptr; /* info structure for str - IN */ 32 33 dcl 1 afnt aligned like fntstk_entry based (afnt_ptr); 34 /* string that fits */ 35 dcl 1 meas1 aligned like text_entry.cur based (meas1_ptr); 36 /* overflow string */ 37 dcl 1 meas2 aligned like text_entry.cur based (meas2_ptr); 38 39 /* LOCAL STORAGE */ 40 41 dcl art_str_ptr ptr; /* art symbol overlay */ 42 dcl art_str char (3) unal based (art_str_ptr); 43 /* artwork strings */ 44 dcl 1 art_xcep static options (constant), 45 2 str (50) char (6) 46 init ("/oo/", "/ss/", "/cc/", "/==/", "|--|", "|**|", "-~~-", "~**~", 47 "SvvS", "svvs", "s""""s", "S^^S", "s^^s", "S""""S", "HvvH", "hvvh", 48 "h""""h", "H^^H", "h^^h", "H""""H", "0^^0", "1^^1", "2^^2", "3^^3", 49 "4^^4", "5^^5", "6^^6", "7^^7", "8^^8", "9^^9", "0vv0", "1vv1", "2vv2", 50 "3vv3", "4vv5", "5vv5", "6vv6", "7vv7", "8vv8", "9vv9", "0^^0", "1^^1", 51 "2^^2", "3^^3", "4^^5", "5^^5", "6^^6", "7^^7", "8^^8", "9^^9"), 52 2 code (50) char (1) 53 init ("o", "s", "c", "=", "`", " ", "f", " ", 54 (42) (1)""); 55 dcl art_xcep_ndx fixed bin; /* index of art_str in xcep list */ 56 dcl avg1 fixed bin (31); /* accumulated average wordspace */ 57 dcl avgwsp fixed bin (31); /* current average wordspace */ 58 dcl brkrw fixed bin (31); /* width of word breaker */ 59 dcl chrct1 fixed bin; 60 dcl ctl_width fixed bin (31); /* width of device ctl string */ 61 dcl debug_sw bit (1); /* effective debug switch */ 62 dcl detail_sw bit (1); /* effective detail debug switch */ 63 dcl ENwidth fixed bin (31); /* width of EN */ 64 dcl gap_ahead fixed bin; 65 dcl gap_found bit (1); 66 dcl gaps1 fixed bin; 67 dcl hyphenated bit (1); 68 dcl iscn fixed bin; /* string scanning index */ 69 dcl (jj, k) fixed bin; /* working index */ 70 dcl 1 lfnt aligned like fntstk_entry; 71 dcl lmeas fixed bin (31); 72 dcl max1 fixed bin (31); /* accumulated maximum wordspace */ 73 dcl maxwsp fixed bin (31); /* current maximum wordspace */ 74 dcl min1 fixed bin (31); /* accumulated minimum wordspace */ 75 dcl minwsp fixed bin (31); /* current minimum wordspace */ 76 dcl mptstrk fixed bin (31); /* mpt -> strokes conversion */ 77 dcl oflo bit (1); /* line overflow switch */ 78 dcl PSwidth fixed bin (31); /* width of PS */ 79 dcl runits fixed bin; /* rel_units in current font */ 80 dcl str char (1020) var; /* working string */ 81 dcl strlen fixed bin; 82 dcl tchar char (1); /* for debugging */ 83 dcl trnsw bit (1); /* 1= translation is active */ 84 dcl true_size fixed bin (31); /* true point size */ 85 dcl width1 fixed bin (31); /* string width accumulator */ 86 dcl word char (1020) var; /* measured word */ 87 dcl wordct fixed bin; /* chars in word */ 88 dcl wrdstrt fixed bin; /* start of word in string */ 89 dcl wordu fixed bin (31); /* word size */ 90 dcl wrdbrkr char (1); 91 92 dcl (addr, bin, dec, divide, index, length, ltrim, max, min, null, rank, 93 reverse, round, rtrim, search, substr, unspec, verify) 94 builtin; 95 96 strlen = length (a_str); /* copy args */ 97 str = a_str; /**/ 98 /* set debug switches */ 99 debug_sw = (shared.bug_mode & db_sw); 100 detail_sw = (debug_sw & dt_sw); 101 102 if debug_sw 103 then call ioa_ ("measure: (^d/^d w^f g^d ^f^2(/^f^) m^f ^a ^f" 104 || "^[ F^; ^^F^]^[ A^; ^^A^])^/^5x""^a^vx""", meas1.chrct, 105 strlen, show (meas1.width, 12000), meas1.gaps, 106 show (meas1.width + meas1.min, 12000), 107 show (meas1.width + meas1.avg, 12000), 108 show (meas1.width + meas1.max, 12000), show (a_lmeas, 12000), 109 afnt.name, show (afnt.size, 1000), fill, art, 110 comp_util_$display (a_str, 0, "0"b), 111 strlen - length (rtrim (a_str))); 112 113 lfnt, meas1.font = afnt; /* starting font for string */ 114 fnttbl_ptr = fnttbldata.ptr (lfnt.devfnt); 115 if fill 116 then wrdbrkr = shared.wrd_brkr; 117 else wrdbrkr = ""; 118 119 if siztbl.ct = 1 /* validate size */ 120 then true_size = siztbl.size (1); 121 else true_size = afnt.size; 122 123 runits = fnttbl.rel_units; /* conversion values in current font */ 124 mptstrk = divide (true_size, runits, 31, 0); 125 126 minwsp = fnttbl.min_wsp; /* wordspace values */ 127 avgwsp = fnttbl.avg_wsp; 128 maxwsp = fnttbl.max_wsp; /**/ 129 /* other useful widths */ 130 ENwidth = fnttbl.units (rank (EN)); 131 PSwidth = fnttbl.units (rank (PS)); 132 133 wrdstrt, wordu, ctl_width, gap_ahead = 0; 134 135 word = ""; /* initialize local values */ 136 unspec (meas2), gap_found, hyphenated, oflo = "0"b; 137 meas2.font = afnt; 138 trnsw = (length (shared.trans.in) > 0); 139 140 lmeas = a_lmeas; 141 if lmeas ^= 0 142 then lmeas = divide (lmeas, mptstrk, 31, 0); 143 width1 = meas1.width; 144 145 chrct1 = meas1.chrct; 146 gaps1 = meas1.gaps; 147 if width1 ^= 0 148 then width1 = divide (width1, mptstrk, 31, 0); 149 min1 = meas1.min; 150 if min1 ^= 0 151 then min1 = divide (min1, mptstrk, 31, 0); 152 avg1 = meas1.avg; 153 if avg1 ^= 0 154 then avg1 = divide (avg1, mptstrk, 31, 0); 155 max1 = meas1.max; 156 if max1 ^= 0 157 then max1 = divide (max1, mptstrk, 31, 0); 158 159 scan_loop: /* scan the given string */ 160 do iscn = chrct1 + 1 by 0 while (iscn <= strlen); 161 162 font_char: 163 do; 164 word = ""; 165 wordct, wordu = 0; 166 wrdstrt = iscn; 167 168 if iscn <= strlen 169 then 170 font_char_loop: 171 do iscn = iscn to strlen; /* take all font chars */ 172 173 (nostrg): 174 next_tchar: 175 tchar = substr (str, iscn, 1); 176 if tchar = DC1 /* device control string? */ 177 then 178 ctl_char: 179 do; /**/ 180 if wordu > 0 /* any text pending? */ 181 then 182 do; 183 if detail_sw 184 then call ioa_ ("^[^-^6x^]^4d,^2d ""^a"" ^f " 185 || "(g^d ^f = ^f/^f/^f)", ^gap_found, wrdstrt, 186 wordct, comp_util_$display (word, 0, "0"b), 187 show (wordu * mptstrk, 12000), gaps1, 188 show ((width1 + wordu) * mptstrk, 12000), 189 show ((width1 + wordu + min1) * mptstrk, 12000), 190 show ((width1 + wordu + avg1) * mptstrk, 12000), 191 show ((width1 + wordu + max1) * mptstrk, 12000)); 192 193 /* width1 = width1 + wordu; 194*/* wordu = 0;*/ 195 gap_found = "0"b; 196 end; /**/ 197 /* set control pointer */ 198 DCxx_p = addr (substr (str, iscn, 1)); 199 /* nothing more for waits */ 200 if dcfs.type = type_wait 201 then ; 202 203 if dcfs.type = type_font/* is it a font change? */ 204 then 205 do; /* really changing? */ 206 if lfnt.devfnt ^= dcfs.f 207 then 208 do; 209 lfnt.devfnt = dcfs.f; 210 fnttbl_ptr = fnttbldata.ptr (lfnt.devfnt); 211 lfnt.name = fnttbl.name; 212 /* new rel units? */ 213 if runits ^= fnttbl.rel_units 214 then 215 do; 216 runits = fnttbl.rel_units; 217 mptstrk = divide (true_size, runits, 31, 0); 218 minwsp = divide (fnttbl.min_wsp, mptstrk, 31, 0); 219 avgwsp = divide (fnttbl.avg_wsp, mptstrk, 31, 0); 220 maxwsp = divide (fnttbl.max_wsp, mptstrk, 31, 0); 221 ENwidth = fnttbl.units (rank (EN)); 222 PSwidth = fnttbl.units (rank (PS)); 223 end; 224 end; /**/ 225 /* changing size? */ 226 if lfnt.size ^= dcfs.p 227 then 228 do; 229 lfnt.size = dcfs.p; 230 /* revalidate size */ 231 if siztbl.ct = 1 232 then true_size = siztbl.size (1); 233 else true_size = lfnt.size; 234 end; 235 end; 236 237 else 238 do; /* must be shift or plot */ 239 if dcxx.Xctl = "01"b/* if an X value, account for it */ 240 then ctl_width = divide (dcshort_val.v1, mptstrk, 31, 0); 241 else if dcxx.Xctl = "10"b 242 then ctl_width = divide (dclong_val.v1, mptstrk, 31, 0); 243 else ctl_width = 0; /* clear control width */ 244 end; 245 246 if lmeas > 0 /* dont do more than we have to */ 247 then if width1 + ctl_width > lmeas 248 then goto return_; 249 250 wordu = wordu + ctl_width; 251 wordct = wordct + dcxx.leng + 3; 252 word = word || substr (str, iscn, dcxx.leng + 3); 253 254 if detail_sw 255 then call ioa_ ("^[^-^6x^]^4d,^2d ""^a"" ^f " 256 || "(g^d ^f = ^f/^f/^f)", ^gap_found, wrdstrt, 257 wordct, comp_util_$display (word, 0, "0"b), 258 show (wordu * mptstrk, 12000), gaps1, 259 show ((width1 + wordu) * mptstrk, 12000), 260 show ((width1 + wordu + min1) * mptstrk, 12000), 261 show ((width1 + wordu + avg1) * mptstrk, 12000), 262 show ((width1 + wordu + max1) * mptstrk, 12000)); 263 264 gap_found = "0"b; /* skip over control string */ 265 iscn = iscn + dcxx.leng + 3; 266 267 if iscn <= strlen 268 then goto next_tchar; 269 else goto EOL_check; 270 end ctl_char; 271 272 if art /* check for line art symbols */ 273 then 274 art_: 275 do; 276 art_str_ptr = addr (substr (str, iscn)); 277 278 if iscn < strlen - 1 /* dont check EOL garbage */ 279 then if substr (art_str, 2, 1) = BSP 280 then 281 do; 282 art_xcep_ndx = index (string (art_xcep.str), art_str); 283 /* find it? */ 284 if art_xcep_ndx > 0 285 then 286 do; 287 art_xcep_ndx = 288 divide (art_xcep_ndx + 5, 6, 17, 0); 289 290 wordu = wordu 291 + fnttbl 292 .units (rank (art_xcep.code (art_xcep_ndx))); 293 word = word || substr (str, iscn, 3); 294 wordct = wordct + 3; 295 /* step over it */ 296 iscn = iscn + 3; 297 298 if iscn > strlen 299 then 300 do; 301 if detail_sw 302 then call ioa_ ("^[^-^6x^]^4d,^2d ""^a"" ^f " 303 || "(g^d ^f = ^f/^f/^f)", 304 ^gap_found, 305 wrdstrt - bin (word = ""), wordct, 306 comp_util_$display (word, 0, "0"b), 307 show (wordu * mptstrk, 12000), 308 gaps1, 309 show ((width1 + wordu) * mptstrk, 310 12000), 311 show ((width1 + wordu + min1) 312 * mptstrk, 12000), 313 show ((width1 + wordu + avg1) 314 * mptstrk, 12000), 315 show ((width1 + wordu + max1) 316 * mptstrk, 12000)); 317 318 width1 = width1 + wordu; 319 chrct1 = chrct1 + wordct + gap_ahead; 320 meas1.font = lfnt; 321 gap_found = "0"b; 322 gap_ahead, wordu = 0; 323 324 goto return_; 325 end; 326 327 else goto next_tchar; 328 end; 329 end; 330 end art_; 331 332 if trnsw 333 then 334 do; 335 k = index (shared.trans.in, tchar); 336 if k > 0 337 then tchar = substr (shared.trans.out, k, 1); 338 end; /**/ 339 /* if a word break */ 340 if tchar = " " | tchar = wrdbrkr & wrdbrkr ^= "" 341 then 342 do; 343 EOL_check: 344 if detail_sw 345 then call ioa_ ("^[^-^6x^]^4d,^2d ""^a"" ^f " 346 || "(g^d ^f = ^f/^f/^f)", ^gap_found, 347 wrdstrt - bin (word = ""), wordct, 348 comp_util_$display (word, 0, "0"b), 349 show (wordu * mptstrk, 12000), gaps1, 350 show ((width1 + wordu) * mptstrk, 12000), 351 show ((width1 + wordu + min1) * mptstrk, 12000), 352 show ((width1 + wordu + avg1) * mptstrk, 12000), 353 show ((width1 + wordu + max1) * mptstrk, 12000)); 354 /* if word does not overset */ 355 /* or no measure was given */ 356 if width1 + wordu + avg1 <= lmeas | quad = just 357 /**** & (width1 + wordu + avg1 > lmeas*/ 358 & width1 + wordu + min1 <= lmeas | lmeas <= 0 359 then 360 do; /* stay up to date */ 361 width1 = width1 + wordu; 362 chrct1 = chrct1 + wordct + gap_ahead; 363 meas1.font = lfnt; 364 gap_found = "0"b; 365 gap_ahead, wordu, wordct = 0; 366 end; 367 368 else /* this word oversets */ 369 do; 370 if shared.hyph_mode & ^hyphenated 371 & (quad = just & width1 + max1 - maxwsp <= lmeas 372 | quad ^= just & width1 + avg1 - avgwsp <= lmeas) 373 then if try_hyph () 374 then 375 do; 376 hyphenated = "1"b; 377 iscn = wrdstrt; 378 goto font_char; 379 end; 380 381 wrdbrkr = shared.wrd_brkr; 382 383 if chrct1 > 0 & gap_ahead > 0 384 then 385 do; 386 gaps1 = gaps1 - 1; 387 min1 = min1 - minwsp; 388 avg1 = avg1 - avgwsp; 389 max1 = max1 - maxwsp; 390 end; 391 392 if detail_sw 393 then call ioa_$nnl ("^5xOFLO"); 394 395 oflo = "1"b; 396 goto return_; 397 end; 398 399 if iscn < strlen /* if not EOL */ 400 /* or measuring all */ 401 | (iscn = strlen & lmeas = 0) 402 then 403 word_break: 404 do; 405 if tchar ^= " " /* if a word breaker */ 406 then 407 breaker: 408 do; 409 word = word || tchar; 410 wordct = wordct + 1; 411 brkrw = fnttbl.units (rank (tchar)); 412 413 if detail_sw 414 then call ioa_ ("^[^-^6x^]^4d,^2d ""^a"" ^f " 415 || "(g^d ^f = ^f/^f/^f)", ^gap_found, 416 wrdstrt - bin (word = ""), wordct, 417 comp_util_$display (word, 0, "0"b), 418 show ((wordu + brkrw) * mptstrk, 12000), 419 gaps1, 420 show ((width1 + brkrw) * mptstrk, 12000), 421 show ((width1 + brkrw + min1) * mptstrk, 422 12000), 423 show ((width1 + brkrw + avg1) * mptstrk, 424 12000), 425 show ((width1 + brkrw + max1) * mptstrk, 426 12000)); 427 428 iscn = iscn + 1;/* and count the breaker */ 429 /* does it all still fit? */ 430 if width1 + max (min1, 0) + brkrw <= lmeas 431 then 432 do; /* update first return data */ 433 width1 = width1 + brkrw; 434 chrct1 = iscn - 1; 435 meas1.font = lfnt; 436 gap_ahead = 0; 437 goto font_char; 438 end; 439 440 else /* this is the overset "word" */ 441 do; 442 if shared.hyph_mode & ^hyphenated & lmeas > 0 443 & (quad = just 444 & width1 + max1 - maxwsp <= lmeas 445 | quad ^= just 446 & width1 + avg1 - avgwsp <= lmeas) 447 then if try_hyph () 448 then 449 do; 450 hyphenated = "1"b; 451 iscn = wrdstrt; 452 goto font_char; 453 end; 454 455 wrdbrkr = shared.wrd_brkr; 456 oflo = "1"b; 457 goto return_; 458 end; /**/ 459 /* does it all still fit? */ 460 if width1 + avg1 + avgwsp + wordu <= lmeas 461 | quad = just & width1 + wordu + min1 <= lmeas 462 then 463 do; /* update first return data */ 464 width1 = width1 + wordu; 465 chrct1 = iscn - 1; 466 meas1.font = lfnt; 467 goto font_char; 468 end; 469 470 else /* this is the overset word */ 471 do; 472 if shared.hyph_mode & ^hyphenated 473 & (quad = just 474 & width1 + max1 - maxwsp <= lmeas 475 | quad ^= just 476 & width1 + avg1 - avgwsp <= lmeas) 477 then if try_hyph () 478 then 479 do; 480 hyphenated = "1"b; 481 iscn = wrdstrt; 482 goto font_char; 483 end; 484 485 wrdbrkr = shared.wrd_brkr; 486 oflo = "1"b; 487 goto return_; 488 end; 489 end breaker; 490 491 else /* its a wordspace */ 492 wrdspc: 493 do; 494 if fill /* preserve punctuation space */ 495 & search (reverse (word), ".:!?") = 1 496 | search (reverse (word), """)") = 1 497 & search (reverse (word), ".!?") = 2 498 then if width1 + avg1 + PSwidth <= lmeas 499 | quad = just 500 & width1 + min1 + PSwidth <= lmeas 501 then 502 punct: 503 do; /* add PS to the measured string */ 504 (nostrg): 505 str = substr (str, 1, iscn - 1) || PS 506 || substr (str, iscn); 507 strlen = strlen + 1; 508 /* take some width */ 509 width1 = width1 + PSwidth; 510 chrct1 = chrct1 + 1; 511 512 if detail_sw 513 then call ioa_ ("^-^6x^4d, 1 ""^a"" ^f " 514 || "(g^d ^f = ^f/^f/^f)", iscn, 515 comp_util_$display ((PS), 0, "0"b), 516 show (PSwidth * mptstrk, 12000), 517 gaps1, 518 show (width1 * mptstrk, 12000), 519 show ((width1 + min1) * mptstrk, 520 12000), 521 show ((width1 + avg1) * mptstrk, 522 12000), 523 show ((width1 + max1) * mptstrk, 524 12000)); 525 /* step over it */ 526 iscn = iscn + 1; 527 end punct; 528 529 (nostrg): 530 jj = verify (substr (str, iscn), " ") - 1; 531 if jj < 0 532 then jj = strlen - iscn + 1; 533 534 if fill 535 then 536 do; 537 gap_found = "1"b; 538 gap_ahead = 1; 539 540 if jj > 1 /* cast out all multiple blanks */ 541 then 542 do; 543 (nostrg, nostrz): 544 str = substr (str, 1, iscn - 1) || " " 545 || ltrim (substr (str, iscn)); 546 strlen = length (str); 547 end; /**/ 548 /* this isnt EOL */ 549 if iscn <= strlen 550 then 551 do; 552 gaps1 = gaps1 + 1; 553 min1 = min1 + minwsp; 554 avg1 = avg1 + avgwsp; 555 max1 = max1 + maxwsp; 556 /* end of undent field? */ 557 if width1 >= lmeas & lmeas > 0 & ^fill 558 then goto return_; 559 end; 560 561 if detail_sw & gaps1 > 0 562 then call ioa_$nnl ("^4d gap ^2d ^f", iscn, gaps1, 563 show (avgwsp * mptstrk, 12000)); 564 565 iscn = iscn + 1; 566 end; 567 568 else if art 569 then 570 do; 571 str = substr (str, 1, iscn - 1) || copy (EN, jj) 572 || ltrim (substr (str, iscn)); 573 574 width1 = width1 + jj * ENwidth; 575 chrct1 = chrct1 + jj; 576 577 if detail_sw 578 then call ioa_$nnl ("^4d ^2d EN^[s^;^x^] ^f", iscn, 579 jj, (jj > 1), show (jj * ENwidth, 12000)) 580 ; 581 iscn = iscn + jj; 582 gap_found = "1"b; 583 end; 584 585 else 586 do; 587 width1 = width1 + jj * ENwidth; 588 chrct1 = chrct1 + jj; 589 590 if detail_sw 591 then call ioa_$nnl ("^4d ^2d SP^[s^;^x^] ^f", iscn, 592 jj, (jj > 1), 593 show (jj * ENwidth * mptstrk, 12000)); 594 iscn = iscn + jj; 595 gap_found = "1"b; 596 end; 597 598 goto font_char; 599 end wrdspc; 600 end word_break; 601 else goto return_; 602 end; 603 604 else 605 do; 606 if tchar = PS /* punctuation space? */ 607 then 608 do; /* does the word fit? */ 609 if width1 + wordu + avg1 <= lmeas 610 | quad = just & width1 + wordu + min1 <= lmeas 611 then 612 do; /* if PS does not overset */ 613 /* take the units for PS */ 614 if width1 + avg1 + PSwidth < lmeas 615 | quad = just & width1 + PSwidth + min1 <= lmeas 616 then 617 do; 618 wordu = wordu + fnttbl.units (rank (tchar)); 619 word = word || PS; 620 wordct = wordct + 1; 621 end; 622 623 else 624 do; /* throw the PS away */ 625 substr (str, iscn) = substr (str, iscn + 1); 626 strlen = strlen - 1; 627 /* discard 1 char for loop control */ 628 iscn = iscn - 1; 629 end; 630 end; 631 632 else if fill /* this is the overset word */ 633 then 634 do; /* set return data */ 635 if shared.hyph_mode & ^hyphenated 636 & (quad = just & width1 + max1 - maxwsp <= lmeas 637 | quad ^= just & width1 + avg1 - avgwsp <= lmeas) 638 then if try_hyph () 639 then 640 do; 641 hyphenated = "1"b; 642 iscn = wrdstrt; 643 goto font_char; 644 end; 645 646 wrdbrkr = shared.wrd_brkr; 647 oflo = "1"b; 648 goto return_; 649 end; 650 end; /**/ 651 /* NOT punctuation space */ 652 else if tchar ^= DC1 653 then 654 do; 655 wordu = wordu + fnttbl.units (rank (tchar)); 656 word = word || tchar; 657 wordct = wordct + 1; 658 end; 659 end; 660 end font_char_loop; 661 end font_char; 662 end_scan_loop: 663 end scan_loop; /**/ 664 /* fell out, must be EOL */ 665 if wordu > 0 /* any leftovers? */ 666 then goto EOL_check; 667 668 return_: 669 if chrct1 > 0 /* strip trailing PS */ 670 then if substr (str, chrct1, 1) = PS 671 then 672 do; 673 if chrct1 = strlen 674 then str = substr (str, 1, chrct1 - 1); 675 else 676 (nostrg): 677 str = substr (str, 1, chrct1 - 1) || substr (str, chrct1 + 1); 678 width1 = width1 - PSwidth; 679 chrct1 = chrct1 - 1; 680 meas2.chrct = meas2.chrct - 1; 681 strlen = strlen - 1; 682 end; 683 684 meas1.chrct = min (chrct1, strlen); 685 meas1.gaps = max (gaps1, 0); 686 meas1.avg = max (avg1 * mptstrk, 0); 687 meas1.min = max (min1 * mptstrk, 0); 688 meas1.max = max (max1 * mptstrk, 0); 689 meas1.width = max (width1 * mptstrk, 0); 690 691 if ^oflo 692 then meas2.font = meas1.font; 693 694 else 695 do; 696 meas2.font = lfnt; 697 meas2.chrct = min (iscn - bin (iscn < strlen), strlen); 698 meas2.gaps = gaps1 + gap_ahead; 699 meas2.width = (width1 + wordu) * mptstrk; 700 meas2.min = (min1 + minwsp) * mptstrk; 701 meas2.avg = (avg1 + avgwsp) * mptstrk; 702 meas2.max = (max1 + maxwsp) * mptstrk; 703 end; 704 705 a_str = str; /* store back possibly modified str */ 706 707 if debug_sw 708 then 709 do; 710 if detail_sw & (^fill & chrct1 = strlen) 711 | (fill & chrct1 = length (rtrim (a_str))) 712 then call ioa_$nnl ("^5xEOL"); 713 714 iscn = chrct1 - length (rtrim (substr (str, 1, chrct1))); 715 call ioa_ ("^/^5x(measure: [1=^d/^d^2( ^f^)^2(/^f^)] " 716 || "[2=^d/^d^2( ^f^)^2(/^f^)] ^a ^f)^[^/^-""^a^vx""^]", 717 meas1.chrct, meas1.gaps, show (meas1.width, 12000), 718 show (meas1.width + meas1.min, 12000), 719 show (meas1.width + meas1.avg, 12000), 720 show (meas1.width + meas1.max, 12000), meas2.chrct, meas2.gaps, 721 show (meas2.width, 12000), show (meas2.width + meas2.min, 12000), 722 show (meas2.width + meas2.avg, 12000), 723 show (meas2.width + meas2.max, 12000), meas2.font.name, 724 show (meas2.font.size, 1000), (meas1.chrct > 0), 725 comp_util_$display (substr (str, 1, meas1.chrct), 0, "0"b), iscn); 726 727 if meas2.chrct > 0 728 then 729 do; 730 call ioa_ ("^-""^a""", 731 comp_util_$display ( 732 substr (str, meas1.chrct + 1, meas2.chrct - meas1.chrct), 0, 733 "0"b)); 734 end; 735 end; 736 737 return; 738 739 hyph_wrd: 740 proc (hword, hspace, hpoint, ercd); 741 742 dcl hword char (*); 743 dcl hspace fixed bin; 744 dcl hpoint fixed bin; 745 dcl ercd fixed bin (35); 746 747 dcl (i, j) fixed bin; 748 dcl space fixed bin; 749 750 dcl hyphenate_word_ 751 entry (char (*), fixed bin, fixed bin, fixed bin (35)); 752 753 ercd = 0; /* preset output values */ 754 hpoint = 0; /**/ 755 /* check impossible cases */ 756 if hspace < 2 | hspace > length (hword) 757 then return; 758 else space = hspace; 759 760 if shared.hwrd_data_ptr ^= null /* is hword in the hwrd list */ 761 then 762 do; 763 do j = 1 to hwrd_data.count while (hwrd_data.word (j) ^= hword); 764 end; 765 766 if j <= hwrd_data.count /* yes */ 767 then 768 do; /* try hyphenation first */ 769 i = index (reverse (substr (hwrd_data.hpts (j), 1, space - 1)), 770 "1"b); 771 if i ^= 0 772 then i = space - i; 773 if i < length (hword) 774 then if substr (hword, i + 1, 1) = "-" 775 then i = i + 1; 776 777 if i = 0 /* no hyphenation point */ 778 then 779 do; 780 i = index (reverse (hwrd_data.brkpts (j)), "1"b); 781 end; 782 783 hpoint = i; 784 end; 785 786 else call hyphenate_word_ (hword, space, hpoint, ercd); 787 788 end; 789 790 else call hyphenate_word_ (hword, space, hpoint, ercd); 791 792 end hyph_wrd; 793 794 show: 795 proc (datum, scale) returns (fixed dec (11, 3)); 796 dcl datum fixed bin (31); 797 dcl scale fixed bin (31); 798 dcl retval fixed dec (11, 3); 799 800 retval = round (dec (round (divide (datum, scale, 31, 11), 10), 11, 4), 3); 801 return (retval); 802 end show; 803 804 try_hyph: 805 proc returns (bit (1)); 806 807 dcl ercd fixed bin (35); 808 dcl hp_space fixed bin (31); /* width of hyph punct */ 809 dcl hpoint fixed bin; 810 dcl hscndx fixed bin; /* word scan index */ 811 dcl hspace fixed bin; /* line chars left for hyphenation */ 812 dcl hword char (strlen - chrct1 + 2) var; 813 dcl hwrdl fixed bin static;/* length of trial hyphenation word */ 814 dcl i fixed bin; 815 816 hscndx = wrdstrt; 817 hwrdl = iscn - wrdstrt; 818 819 trim_trailing: /* any trailing punctuation? */ 820 if search (reverse (substr (str, hscndx, hwrdl)), ".,;:!?""" || wrdbrkr) 821 = 1 822 then 823 do; 824 hwrdl = hwrdl - 1; 825 goto trim_trailing; 826 end; /**/ 827 /* line space left (in chars) */ 828 if quad = just 829 then hspace = 830 divide ((lmeas - width1 - min1) * mptstrk, shared.EN_width, 17, 831 0); 832 else hspace = 833 divide ((lmeas - width1 - avg1) * mptstrk, shared.EN_width, 17, 834 0); 835 836 hp_space = 0; /* check leading punctuation */ 837 trim_leading: 838 if index ("/([{""" || PAD || wrdbrkr, substr (str, hscndx, 1)) ^= 0 839 then 840 do; 841 hp_space = hp_space + /* calculate its width */ 842 fnttbl.units (rank (substr (str, hscndx, 1))); 843 hscndx = hscndx + 1; /* step over it */ 844 hspace = hspace - 1; /* 1 fewer hyph chars */ 845 hwrdl = hwrdl - 1; 846 goto trim_leading; 847 end; 848 849 i = -1 /* anything embedded? */ 850 + 851 verify (reverse (substr (str, hscndx, hwrdl)), 852 "/.;:!?,()[]{}""" || PAD || PS); 853 if i > 0 854 then 855 do; 856 hwrdl = hwrdl - i; /* to force hyphenation */ 857 hspace = min (hspace, hwrdl - 1); 858 end; 859 860 if hspace > shared.hyph_size /* enough space? */ 861 then 862 do; 863 hpoint = 0; /* clear hyph point index */ 864 hword = substr (str, hscndx, hwrdl); 865 866 if shared.bug_mode 867 then call ioa_$nnl ("^5x(hyph: ^d ^d ""^a""", hspace, hwrdl, hword); 868 869 call hyph_wrd (substr (str, hscndx, hwrdl), hspace, hpoint, ercd); 870 if ercd ^= 0 871 then goto hyph_err; 872 873 if hpoint = 0 /* try simple plurals */ 874 then 875 do; 876 if index (substr (hword, hwrdl), "s") = 1 877 then 878 do; 879 call hyph_wrd (substr (hword, 1, hwrdl - 1), hspace, hpoint, 880 ercd); 881 if ercd ^= 0 882 then goto hyph_err; 883 end; 884 885 if hpoint = 0 886 then 887 do; 888 if index (substr (hword, hwrdl), "es") = 1 889 then 890 do; 891 call hyph_wrd (substr (hword, 2, hwrdl - 2), hspace, 892 hpoint, ercd); 893 if ercd ^= 0 894 then goto hyph_err; 895 end; 896 897 if hpoint = 0 898 then 899 do; 900 if index (substr (hword, hwrdl), "ies") = 1 901 then 902 do; 903 call hyph_wrd (substr (hword, 3, hwrdl - 3) || "y", 904 hspace, hpoint, ercd); 905 if ercd ^= 0 906 then 907 hyph_err: 908 call comp_report_$ctlstr (2, ercd, text.input.info, 909 str, 910 "Error returned by hyphenate_word_ subroutine.") 911 ; 912 return ("0"b); 913 end; 914 end; 915 end; 916 end; 917 918 if shared.bug_mode 919 then call ioa_ (" @ ^d)", hpoint); 920 921 hyph_it: 922 if hpoint >= shared.hyph_size 923 then 924 do; 925 hpoint = hscndx + hpoint - 1; 926 927 if substr (str, hpoint, 1) ^= "-" 928 then 929 do; /* insert the "-" */ 930 str = substr (str, 1, hpoint) || "-" 931 || substr (str, hpoint + 1); 932 strlen = strlen + length ("-"); 933 hpoint = hpoint + length ("-"); 934 /* adjust modified text */ 935 if strlen <= text.input.mod_start 936 then text.input.mod_start = 937 text.input.mod_start + length ("-"); 938 else if strlen <= text.input.mod_start + text.input.mod_len - 1 939 then text.input.mod_len = text.input.mod_len + length ("-"); 940 end; 941 942 wrdbrkr = "-"; /* set hyphen as word breaker */ 943 gap_found = "0"b; 944 return ("1"b); 945 end; 946 947 if hpoint = 0 948 then 949 do; /**/ 950 /* unbreakable word? */ 951 if width1 = 0 & wordu > divide (text.parms.measure, mptstrk, 31, 0) 952 then 953 do; 954 call comp_report_$ctlstr (2, 0, info_ptr, ctl_line, 955 "Text too long for output line."); 956 957 /* meas1 = meas2; 958*/* strlen = meas2.chrct; 959*/* text.input.quad = quadl;*/ 960 961 /* call put_line; 962*/* text.input.quad = just;*/ 963 964 /* goto fill_loop;*/ 965 return ("0"b); 966 end; 967 end; 968 969 end; 970 971 return ("0"b); 972 973 end try_hyph; 974 975 alln: 976 entry; 977 db_sw, dt_sw = "1"b; 978 return; 979 allf: 980 entry; 981 db_sw, dt_sw = "0"b; 982 return; 983 dbn: 984 entry; 985 db_sw = "1"b; 986 return; 987 dbf: 988 entry; 989 db_sw = "0"b; 990 dt_sw = "0"b; 991 return; 992 dcl db_sw bit (1) static init ("0"b); 993 994 dtn: 995 entry; 996 db_sw = "1"b; 997 dt_sw = "1"b; 998 return; 999 dtf: 1000 entry; 1001 dt_sw = "0"b; 1002 return; 1003 dcl dt_sw bit (1) static init ("0"b); 1004 1 1 /* BEGIN INCLUDE FILE ..... comp_DCdata.incl.pl1 ..... 11/16/78 J Falksen 1 2* Modified: ??/81 - EJW - Addded type_wait 1 3* Modified: 4/83 - EJW - Added type_un(strt stop), reorganized file. 1 4**/ 1 5 1 6 /* format: style2,ind3,ll79,dclind4,idind15,comcol41,linecom */ 1 7 1 8 dcl DCxx_p ptr; /* for qualification of embedded */ 1 9 /* control strings */ 1 10 /* an embedded control string */ 1 11 dcl 1 dcxx unal based (DCxx_p), 1 12 2 mark char (1) unal, /* control marker - DC1 (\021) */ 1 13 2 ctl, 1 14 3 type bit (3) unal, /* 000- device/writer control */ 1 15 /* 001- */ 1 16 /* 010- literal data */ 1 17 /* 011- family/member/size data */ 1 18 /* 100- shift */ 1 19 /* 101- */ 1 20 /* 110- vector */ 1 21 /* 111- zero-offset vector */ 1 22 3 fill1 bit (1) unal, 1 23 3 Xctl bit (2) unal, /* 00- no X value present */ 1 24 /* 01- short X value */ 1 25 /* 10- long X value */ 1 26 3 fill2 bit (1) unal, 1 27 3 Yctl bit (2) unal, /* 00- no Y value present */ 1 28 /* 01- short Y value present */ 1 29 /* 10- long Y value present */ 1 30 2 leng fixed bin (9) unal unsigned, 1 31 /* # of remaining bytes */ 1 32 2 etc; /* the rest of the control bytes */ 1 33 /* device/writer controls */ 1 34 dcl 1 dcctl unal based (DCxx_p), 1 35 2 mark char (1) unal, 1 36 2 type char (1) unal, /* control type */ 1 37 /* leng is always 0 for these */ 1 38 2 leng fixed bin (9) unal unsigned; 1 39 dcl ( 1 40 wait_signal init (" "), /* = 021001000 */ 1 41 unstart_signal init (" "), /* = 021002000 */ 1 42 unstop_signal init (" ") /* = 021003000 */ 1 43 ) char (3) static options (constant); 1 44 /* the "literal" control string */ 1 45 dcl 1 dclit unal based (DCxx_p), 1 46 2 mark char (1) unal, 1 47 2 type char (1) unal, /* control type */ 1 48 2 leng fixed bin (9) unal unsigned, 1 49 /* width in milli-points of literal */ 1 50 2 width fixed bin (31) unal, 1 51 /* actual literal, max length 509 */ 1 52 2 data char (dclit.leng - 4); 1 53 /* long (31 bits) values */ 1 54 dcl 1 dclong_val unal based (DCxx_p), 1 55 2 mark char (1) unal, 1 56 2 type char (1) unal, /* control type */ 1 57 2 leng fixed bin (9) unal unsigned, 1 58 ( 1 59 2 v1 fixed bin (31), /* long value */ 1 60 2 v2 fixed bin (31) /* long value */ 1 61 ) unal; 1 62 dcl ( 1 63 dclong_len init (8), /* 2 long values */ 1 64 dclong1_len init (4) /* 1 long value */ 1 65 ) fixed bin static options (constant); 1 66 /* short (17 bit) values */ 1 67 dcl 1 dcshort_val unal based (DCxx_p), 1 68 2 mark char (1) unal, 1 69 2 type char (1) unal, /* control type */ 1 70 2 leng fixed bin (9) unal unsigned, 1 71 ( 1 72 2 v1 fixed bin, /* short value */ 1 73 2 v2 fixed bin /* short value */ 1 74 ) unal; 1 75 dcl ( 1 76 dcshort_len init (4), /* 2 short values */ 1 77 dcshort1_len init (2) /* 1 short value */ 1 78 ) fixed bin static options (constant); 1 79 /* a font change string */ 1 80 dcl 1 dcfs unal based (DCxx_p), 1 81 2 mark char (1) unal, /* font/size data */ 1 82 2 type char (1) unal, /* control type */ 1 83 2 leng fixed bin (9) unal unsigned, 1 84 /* fnttbldata index */ 1 85 2 f fixed bin (9) unal unsigned, 1 86 /* point size in milli-points */ 1 87 2 p fixed bin (31) unal; 1 88 dcl dcfs_len fixed bin init (5) static options (constant); 1 89 1 90 dcl ( /* symbolic definitions of DC types */ 1 91 type_wait init (""), /* writer wait */ 1 92 type_unstart init (""), /* underscore start */ 1 93 type_unstop init (""), /* underscore stop */ 1 94 type_lit init (""), /* literal data */ 1 95 type_font init (""), /* family/member/size data */ 1 96 /* SHIFTS - */ 1 97 type_sy init (""), /* -- no x, short y */ 1 98 type_sly init (""), /* -- no x, long y */ 1 99 type_sx init (""), /* -- short x, no y */ 1 100 type_sxy init (" "), /* -- short x, short y */ 1 101 type_slx init (""), /* -- long x, no y */ 1 102 type_slxly init (""), /* -- long x, long y */ 1 103 /* VECTORS */ 1 104 type_vy init (""), /* -- no x, short y */ 1 105 type_vly init (""), /* -- no x, long y */ 1 106 type_vx init (""), /* -- short x, no y */ 1 107 type_vxy init (""), /* -- short x, short y */ 1 108 type_vlx init (""), /* -- long x, no y */ 1 109 type_vlxly init (""), /* -- long x, long y */ 1 110 /* ZERO-OFFSET VECTORS- */ 1 111 type_v0y init (""), /* -- no x, short y */ 1 112 type_v0ly init (""), /* -- no x, long y */ 1 113 type_v0x init (""), /* -- short x, no y */ 1 114 type_v0xy init (""), /* -- short x, short y */ 1 115 type_v0lx init (""), /* -- long x, no y */ 1 116 type_v0lxly init ("") /* -- long x, long y */ 1 117 ) char (1) unal int static options (constant); 1 118 1 119 /* END INCLUDE FILE ..... comp_DCdata.incl.pl1 ..... */ 1005 2 1 /* BEGIN INCLUDE FILE - comp_dvt.incl.pl1 */ 2 2 2 3 /* Written: 9/80 - JA Falksen 2 4*/* Modified: 11/81 - EJW - Added comp_dvt.displayproc 2 5*/* Modified: 1/82 - EJW - Added length arg to comp_dvt.displayproc 2 6*/* Modified: 2/82 - EJW - Deleted ptr arg from comp_dvt.displayproc 2 7*/* Modified: 3/83 - EJW - Changed footref arg of comp_dvt.footproc to 2 8* (3) char (*) var. Version 4. */ 2 9 /* Modified: 6/83 - EJW - Added error print control switch to calling 2 10* sequence for comp_dvt.displayproc. - Version 5. 2 11*/* Modified: 11/84 - EJW - Renamed no_adjust to justifying. 2 12**/ 2 13 2 14 /* All names which end in "_r"are offset values within the device table */ 2 15 /* segment. The version of this structure is in comp_dvid.incl.pl1 */ 2 16 2 17 /* format: style2,ind3,ll79,dclind4,idind15,comcol41,linecom */ 2 18 2 19 dcl 1 comp_dvt aligned based (const.devptr), 2 20 2 devclass char (32), /* what general kind of device is */ 2 21 /* this, currently available: */ 2 22 /* "printer" (includes terminals), */ 2 23 /* "braille", "bitmap" */ 2 24 2 outproc entry /* page output processor */ 2 25 (fixed bin, /* function - 0=build */ 2 26 /* 1=init page */ 2 27 /* 2=init file */ 2 28 /* 3=cleanup */ 2 29 fixed bin (35)),/* error code */ 2 30 2 footproc entry /* footnote reference proc */ 2 31 ((3) char (*) var, 2 32 /* reference string (IN/OUT) */ 2 33 ptr), /* comp_dvt_p (IN) */ 2 34 2 artproc entry (), /* artwork proc */ 2 35 /* dont know how to describe yet */ 2 36 2 displayproc 2 37 entry /* string display interpreter */ 2 38 (char (*) var, /* raw input string */ 2 39 fixed bin (24), /* chars used in this call */ 2 40 bit (1)) /* 1= dont show display errors */ 2 41 returns (char (*) var), 2 42 /* interpreted output string */ 2 43 /* following values are in millipoints */ 2 44 2 min_WS fixed bin (31), /* minimum whitespace */ 2 45 2 min_lead fixed bin (31), /* minimun lead */ 2 46 2 vmt_min fixed bin (31), /* min usable .vmt */ 2 47 2 vmb_min fixed bin (31), /* min usable .vmb */ 2 48 2 def_vmt fixed bin (31), /* default .vmt */ 2 49 2 def_vmh fixed bin (31), /* default .vmh */ 2 50 2 def_vmf fixed bin (31), /* default .vmf */ 2 51 2 def_vmb fixed bin (31), /* default .vmb */ 2 52 2 pdw_max fixed bin (31), /* max page width available */ 2 53 2 pdl_max fixed bin (31), /* max page length available, */ 2 54 /* (0 = unlimited) */ 2 55 2 upshift fixed bin (31), /* footnote reference shift */ 2 56 2 init_ps fixed bin (31), /* initial pointsize (millipoints) */ 2 57 2 lettersp fixed bin (31), /* max letterspacing */ 2 58 2 max_pages fixed bin, /* max pages/"file" -1 ->unlimited */ 2 59 2 max_files fixed bin, /* max "files"/reel -1 ->unlimited */ 2 60 2 init_fam fixed bin, /* initial family index */ 2 61 2 init_mem fixed bin, /* initial member index */ 2 62 2 foot_fam fixed bin, /* initial foot family index */ 2 63 2 foot_mem fixed bin, /* initial foot member index */ 2 64 2 init_family 2 65 char (32), /* initial font family to use */ 2 66 2 init_member 2 67 char (32), /* initial font member to use */ 2 68 ( /* the following are offsets */ 2 69 2 atd_r, /* attach desc for on-line output */ 2 70 2 dvc_r, /* device control table relptr */ 2 71 2 comment_r, /* comment string relptr */ 2 72 2 cleanup_r, /* "cleanup" string relptr */ 2 73 2 medsel_table_r /* media select table relptr */ 2 74 ) bit (18) aligned, 2 75 2 foot_family 2 76 char (32), /* family for footnote reference */ 2 77 2 foot_member 2 78 char (32), /* member for footnote reference */ 2 79 /* if one was specified */ 2 80 2 sws unaligned, 2 81 3 interleave /* 0- page block has lines in column */ 2 82 bit (1), /* order left-to-right */ 2 83 /* 1- page block has lines in line */ 2 84 /* order top-to-bottom */ 2 85 3 justifying /* 1- device justifies lines */ 2 86 bit (1), 2 87 3 mbz bit (24), 2 88 3 endpage bit (9), /* EOP char if not "0"b */ 2 89 2 open_mode fixed bin (35), /* when going to a file */ 2 90 2 recleng fixed bin, /* length of tape records */ 2 91 2 family_ct fixed bin, /* # families present */ 2 92 2 family (comp_dvt.family_ct), 2 93 /* families of fonts defined */ 2 94 3 member_r bit (18) aligned, 2 95 /* member table relptr */ 2 96 3 name char (32); /* family name */ 2 97 2 98 2 99 /* The usage formula for units: */ 2 100 /* */ 2 101 /* rel_units * length_in_points */ 2 102 /* ---------------------------- = length_in_units */ 2 103 /* points_per_EM */ 2 104 2 105 /* END INCLUDE FILE comp_dvt.incl.pl1 */ 1006 3 1 /* BEGIN INCLUDE FILE comp_entries.incl.pl1 */ 3 2 3 3 /* format: style2,ind2,ll79,dclind4,idind15,comcol41,linecom */ 3 4 3 5 dcl compose_severity_ 3 6 fixed bin (35) ext static; 3 7 dcl comp_ entry; 3 8 dcl comp_art_ entry (ptr, bit (1)); 3 9 dcl comp_block_ctls_ 3 10 entry (fixed bin); 3 11 dcl comp_break_ entry (fixed bin, fixed bin); 3 12 dcl comp_break_ctls_ 3 13 entry (fixed bin); 3 14 dcl comp_ctls_ entry (bit (1) aligned); 3 15 dcl comp_eject_page_ 3 16 entry; 3 17 dcl comp_expr_eval_ 3 18 entry (char (*) var, fixed bin (21), ptr, fixed bin, 3 19 fixed bin, bit (1), fixed bin (31), char (*) var, 3 20 bit (9), fixed bin (35)); 3 21 dcl comp_extr_str_ entry (bit (1), char (*) var, fixed bin (21), 3 22 fixed bin (21), fixed bin (21), ptr) 3 23 returns (char (*) var); 3 24 dcl comp_fill_ entry; 3 25 dcl comp_font_ entry (bit (1), char (*) var, char (8) aligned); 3 26 dcl comp_format_ctls_ 3 27 entry (fixed bin); 3 28 dcl comp_get_file_$find 3 29 entry (char (*), ptr, char (*), bit (1), char (*) var, 3 30 fixed bin (35)); 3 31 dcl comp_get_file_$open 3 32 entry (ptr, bit (1), fixed bin (35)); 3 33 dcl comp_head_page_ 3 34 entry (fixed bin (31)); 3 35 dcl comp_hft_ctls_ entry (fixed bin); 3 36 dcl comp_hft_ctls_$title 3 37 entry (ptr, ptr, char (*) var, fixed bin (31)); 3 38 dcl comp_init_$one entry; 3 39 dcl comp_init_$two entry; 3 40 dcl comp_init_$three 3 41 entry; 3 42 dcl comp_insert_ctls_ 3 43 entry (fixed bin); 3 44 dcl comp_make_page_ 3 45 entry (fixed bin, bit (1)); 3 46 dcl comp_make_page_$cleanup 3 47 entry; 3 48 dcl comp_measure_ entry (char (1020) var, ptr, bit (1), bit (1), bit (6), 3 49 fixed bin (31), ptr, ptr, ptr); 3 50 dcl comp_read_$name 3 51 entry (char (*) var, fixed bin (21), fixed bin (21), 3 52 ptr) returns (char (*) var); 3 53 dcl comp_read_$number 3 54 entry (char (*) var, (*) fixed bin (31), 3 55 fixed bin (21), fixed bin (21), ptr, fixed bin (35)) 3 56 returns (fixed bin (31)); 3 57 dcl comp_read_$line 3 58 entry (ptr, char (*) var, bit (1)); 3 59 dcl comp_report_ entry (fixed bin, fixed bin (35), char (*), ptr, 3 60 char (*) var); 3 61 dcl comp_report_$ctlstr 3 62 entry options (variable); 3 63 /**** (sev, code, info, line, ctl_str, args... */ 3 64 dcl comp_report_$exact 3 65 entry (char (*), ptr); 3 66 dcl comp_space_ entry (fixed bin (31), ptr, bit (1), bit (1), bit (1), 3 67 bit (1)); 3 68 dcl comp_tbl_ctls_ entry (fixed bin); 3 69 dcl comp_title_block_ 3 70 entry (ptr); 3 71 dcl comp_update_symbol_ 3 72 entry (bit (1), bit (1), bit (1), char (32), 3 73 char (*) var); 3 74 dcl comp_use_ref_ entry (char (*) var, bit (1), bit (1), ptr); 3 75 dcl comp_util_$add_text 3 76 entry (ptr, bit (1), bit (1), bit (1), bit (1), ptr); 3 77 dcl comp_util_$display 3 78 entry (char (*) var, fixed bin, bit (1)) 3 79 returns (char (*) var); 3 80 dcl comp_util_$escape 3 81 entry (char (*) var, ptr); 3 82 dcl comp_util_$getblk 3 83 entry (fixed bin, ptr, char (2), ptr, bit (1)); 3 84 dcl comp_util_$num_display 3 85 entry (ptr, fixed bin) returns (char (256) var); 3 86 dcl comp_util_$pageno 3 87 entry (fixed bin, char (*) var); 3 88 dcl comp_util_$pictures /* emit pending pictures */ 3 89 entry /**/ 3 90 (ptr); /* current text block */ 3 91 dcl comp_util_$pop entry (char (32)); 3 92 dcl comp_util_$push 3 93 entry (char (32)); 3 94 dcl comp_util_$relblk 3 95 entry (fixed bin, ptr); 3 96 dcl comp_util_$replace_text 3 97 entry (ptr, bit (1), ptr, ptr); 3 98 dcl comp_util_$search_tree 3 99 entry (char (32), bit (1)); 3 100 dcl comp_util_$set_bin 3 101 entry (fixed bin (31), char (32) var, fixed bin (31), 3 102 fixed bin (31), fixed bin (31), (*) fixed bin (31), 3 103 fixed bin (31)); 3 104 dcl comp_util_$set_net_page 3 105 entry (bit (1)); 3 106 dcl comp_util_$translate 3 107 entry (char (*) var) returns (char (*) var); 3 108 dcl comp_write_block_ 3 109 entry (fixed bin); 3 110 dcl comp_write_page_ 3 111 entry; 3 112 3 113 /* END INCLUDE FILE comp_entries.incl.pl1 */ 1007 4 1 /* BEGIN INCLUDE FILE comp_fntstk.incl.pl1 */ 4 2 4 3 /* format: style2,ind2,ll79,dclind4,idind15,comcol41,linecom */ 4 4 4 5 dcl fntstk_eptr ptr; /* font stack entry structure */ 4 6 dcl 1 fntstk_entry aligned based (fntstk_eptr), 4 7 2 bachelor bit (1), /* 1= has no members */ 4 8 2 devfnt fixed bin, /* font in the device */ 4 9 2 fam_name char (32), /* family name */ 4 10 2 famndx fixed bin, /* family index */ 4 11 2 fntptr ptr, /* font table pointer */ 4 12 2 mem_name char (32), /* /member name (or null) */ 4 13 2 memndx fixed bin, /* member index */ 4 14 2 memptr ptr, /* member table pointer */ 4 15 2 name char (65) var, /* font name */ 4 16 2 size fixed bin (31), /* requested point size */ 4 17 2 ps fixed bin (31), /* effective point size */ 4 18 2 fcs_str char (8); /* FCS string */ 4 19 4 20 /* END INCLUDE FILE comp_fntstk.incl.pl1 */ 1008 5 1 /* BEGIN INCLUDE FILE comp_font.incl.pl1 */ 5 2 5 3 /* Fonts already loaded into the compose (pdir) database */ 5 4 5 5 /* format: style2,ind2,ll79,dclind4,idind15,comcol41,linecom */ 5 6 5 7 dcl 1 fnttbldata aligned based (const.fnttbldata_ptr), 5 8 2 count fixed bin, /* number of fonts loaded */ 5 9 2 ndx fixed bin, /* index of current font */ 5 10 2 medsel_ptr ptr, /* -> media select table */ 5 11 2 ptr (100) ptr; /* 100 fonts should be plenty! */ 5 12 5 13 dcl fnttbl_ptr ptr init (null); 5 14 dcl 1 fnttbl aligned based (fnttbl_ptr), 5 15 2 min_wsp fixed bin, /* min wordspace - in strokes */ 5 16 2 avg_wsp fixed bin, /* nominal wordspace - in strokes */ 5 17 2 max_wsp fixed bin, /* max wordspace - in strokes */ 5 18 2 rel_units fixed bin, /* stroke value for this font */ 5 19 2 siztbl_ptr ptr, /* -> loaded size table */ 5 20 2 entry /* stack entry for this font */ 5 21 like fntstk_entry, 5 22 ( /* for each font character */ 5 23 2 devfnt fixed bin, /* font in the device */ 5 24 2 replptr ptr, /* replacement string ptrs */ 5 25 2 units fixed bin, /* width in strokes */ 5 26 2 white bit (1) unal /* white space flags */ 5 27 ) dimension (0:511); 5 28 5 29 dcl repl_str_ptr ptr; /* replacement strings */ 5 30 dcl 1 repl_str based (repl_str_ptr), 5 31 2 len fixed bin (35), 5 32 2 str char (256); 5 33 dcl replstr char (256) var based (repl_str_ptr); 5 34 /* media select strings */ 5 35 /* (indexed on fnttbldata.ndx) */ 5 36 dcl medsel (100) char (12) based (fnttbldata.medsel_ptr); 5 37 5 38 dcl 1 siztbl based (fnttbl.siztbl_ptr), 5 39 2 ct fixed bin, /* number of sizes */ 5 40 2 size (siztbl.ct) fixed bin (31); 5 41 5 42 /* This is the storage referred by family.member_r in comp_dvt 5 43* 5 44* If member.count is 1 and member.name(1) is null, then the font is a 5 45* 'bachelor'. 5 46* 5 47* The font stack will hold the family/member names which were used to 5 48* originally get to the font. When a bachelor is accessed, the member name 5 49* will remain but the bachelor flag will be set to tell any displayers not 5 50* to include it. 5 51* 5 52* %FontName% will contain either "family" or "family/member" depending on 5 53* the setting of the bachelor switch. */ 5 54 5 55 dcl member_ptr ptr; 5 56 dcl 1 member based (member_ptr), 5 57 2 count fixed bin, /* # members present */ 5 58 2 e (member.count), /* members defined for this device */ 5 59 3 font_r bit (18) unal, /* font character table relptr */ 5 60 3 size_r bit (18) aligned, 5 61 /* point size list relptr */ 5 62 3 Scalex fixed bin (35), /* X (hor) scaling * 1e8 - FUTURE */ 5 63 3 Scaley fixed bin (35), /* Y (ver) scaling * 1e8 - FUTURE */ 5 64 3 name char (32); /* member name */ 5 65 5 66 /* Storage referred by member.font_r */ 5 67 dcl font_ptr ptr; 5 68 dcl 1 font based (font_ptr), 5 69 ( 2 oput_r, /* offset of output data array */ 5 70 2 units_r /* offset of width array */ 5 71 ) bit (18) aligned, 5 72 2 rel_units fixed bin, /* stroke value for this table */ 5 73 2 footsep char (1), /* footref separator */ 5 74 2 fill char (3), 5 75 2 min_wsp fixed bin, /* min wordspace */ 5 76 2 avg_wsp fixed bin, /* nominal wordspace */ 5 77 2 max_wsp fixed bin; /* max wordspace */ 5 78 5 79 /* storage referred by font.units_r */ 5 80 dcl units_ptr ptr; /* width in strokes */ 5 81 dcl units (0:511) fixed bin based (units_ptr); 5 82 5 83 /* media select table in the device table */ 5 84 dcl medsel_table_ptr 5 85 ptr; 5 86 dcl 1 medsel_table based (medsel_table_ptr), 5 87 2 count fixed bin, 5 88 2 ref_r (medsel_table.count) bit (18) aligned; 5 89 5 90 /* storage referred by font.oput_r */ 5 91 dcl oput_p ptr; 5 92 dcl 1 oput based (oput_p), 5 93 2 data_ct fixed bin, /* highest char defined */ 5 94 2 e (0:oput.data_ct), 5 95 3 which /* index into view array */ 5 96 fixed bin (17) unal, 5 97 3 what_r /* output string */ 5 98 bit (18) unal; 5 99 5 100 /* storage referred by member.size_r */ 5 101 5 102 dcl sizel_p ptr; 5 103 dcl 1 sizel based (sizel_p),/* list of allowed point sizes */ 5 104 2 val_ct fixed bin, 5 105 2 val (sizel.val_ct) fixed bin (31); 5 106 5 107 /* storage referred by oput.what_r */ 5 108 5 109 dcl medchar_sel_p ptr; /* MediaChar select string */ 5 110 dcl 1 medchar_sel based (medchar_sel_p), 5 111 2 str_l fixed bin, 5 112 2 str char (medchar_sel.str_l); 5 113 dcl medchar char (medchar_sel.str_l) var based (medchar_sel_p); 5 114 5 115 dcl med_sel_p ptr; /* media select string */ 5 116 dcl 1 med_sel based (med_sel_p), 5 117 2 str_l fixed bin, 5 118 2 str char (med_sel.str_l); 5 119 5 120 /* END INCLUDE FILE comp_font.incl.pl1 */ 1009 6 1 /* BEGIN INCLUDE FILE comp_hwrd_data.incl.pl1 */ 6 2 6 3 dcl 1 hwrd_data aligned based (shared.hwrd_data_ptr), 6 4 2 count fixed bin, /* number of words */ 6 5 2 e (100), /* list entries */ 6 6 3 hpts bit (288), /* hyphenation points */ 6 7 3 brkpts bit (288), /* word break points */ 6 8 3 word char (256); /* the word */ 6 9 6 10 /* END INCLUDE FILE comp_hwrd_data.incl.pl1 */ 1010 7 1 /* BEGIN INCLUDE FILE - comp_metacodes.incl.pl1 */ 7 2 7 3 /* format: style2,ind2,ll79,dclind4,idind25,comcol51,linecom */ 7 4 7 5 /* ASCII control characters */ 7 6 dcl ( 7 7 NUL init (" "), /* 000 */ 7 8 SOH init (""), /* 001 */ 7 9 STX init (""), /* 002 */ 7 10 ETX init (""), /* 003 */ 7 11 EOT init (""), /* 004 */ 7 12 ENQ init (""), /* 005 */ 7 13 ACK init (""), /* 006 */ 7 14 BEL init (""), /* 007 */ 7 15 BSP init (""), /* 010 */ 7 16 HT init (" "), 7 17 /* 011 */ 7 18 (NL, LF) init (" 7 19 "), /* 012 */ 7 20 VT init (""), /* 013 */ 7 21 FF init (""), /* 014 */ 7 22 CR init (" "), /* 015 */ 7 23 (RRS, SO) init (""), /* 016 */ 7 24 (BRS, SI) init (""), /* 017 */ 7 25 DLE init (""), /* 020 */ 7 26 DC1 init (""), /* 021 */ 7 27 (DC2, HLF, HUGE) init (""), /* 022 */ 7 28 DC3 init (""), /* 023 */ 7 29 (DC4, HLR, THICK) init (""), /* 024 */ 7 30 (NAK, MEDIUM) init (""), /* 025 */ 7 31 SYN init (""), /* 026 */ 7 32 (ETB, HAIR) init (""), /* 027 */ 7 33 (CAN, STROKE) init (""), /* 030 */ 7 34 oct031 init (""), /* 031 */ 7 35 SUB init (""), /* 032 */ 7 36 ESC init (""), /* 033 */ 7 37 FS init (""), /* 034 */ 7 38 GS init (""), /* 035 */ 7 39 RS init (""), /* 036 */ 7 40 US init (""), /* 037 */ 7 41 (DEL, PAD) init (""), /* 177 */ 7 42 /* compose meta-characters */ 7 43 multiply init (""), /* 252 - multiply symbol */ 7 44 pl_mi init (""), /* 253 - plus/minus sign */ 7 45 nabla init (""), /* 254 */ 7 46 EMdash init (""), /* 255 - EM dash */ 7 47 slash init (""), /* 256 */ 7 48 dagger init (""), /* 261 */ 7 49 perpen init (""), /* 273 - perpendicular mark */ 7 50 not_eq init (""), /* 275 - not-equal mark */ 7 51 dbldag init (""), /* 301 - double daggar */ 7 52 cright init (""), /* 303 - copyright mark */ 7 53 delta init (""), /* 304 */ 7 54 bullet init (""), /* 315 */ 7 55 prll init (""), /* 316 - parallel mark */ 7 56 PI init (""), /* 320 - uppercase Greek pi */ 7 57 tmark init (""), /* 324 - trademark */ 7 58 tfore init (""), /* 326 - therefore mark */ 7 59 approx init (""), /* 332 - approximately-equal mark */ 7 60 infin init (""), /* 337 - infinity */ 7 61 theta init (""), /* 352 */ 7 62 pi init (""), /* 360 - lowercase Greek pi */ 7 63 square init (""), /* 375 */ 7 64 overbar init (""), /* 376 */ 7 65 PS init (""), /* 377 - punctuation space */ 7 66 sup0 init (" "), /* 400 - superior digit 0 */ 7 67 sup1 init (""), /* 401 - superior digit 1 */ 7 68 sup2 init (""), /* 402 - superior digit 2 */ 7 69 sup3 init (""), /* 403 - superior digit 3 */ 7 70 sup4 init (""), /* 404 - superior digit 4 */ 7 71 sup5 init (""), /* 405 - superior digit 5 */ 7 72 sup6 init (""), /* 406 - superior digit 6 */ 7 73 sup7 init (""), /* 407 - superior digit 7 */ 7 74 sup8 init (""), /* 410 - superior digit 8 */ 7 75 sup9 init (" "), /* 411 - superior digit 9 */ 7 76 EM init (" "), /* 412 - EM space */ 7 77 EM_ init (""), /* 413 - EM aligned dash */ 7 78 EN init (""), /* 414 - EN space */ 7 79 EN_ init (" "), /* 415 - EN aligned dash */ 7 80 ENd init (""), /* 416 - EN dash */ 7 81 THIN init (""), /* 417 - thinspace */ 7 82 DEVIT init (""), /* 420 - device unit */ 7 83 lquote init (""), /* 421 - left double quote */ 7 84 rquote init (""), /* 422 - right double quote */ 7 85 modmark init (""), /* 424 - text modification/addition mark */ 7 86 delmark init (""), /* 430 - deletion mark */ 7 87 vrule init ("Z"), /* 532 - vertical rule */ 7 88 lslnt init ("^") /* 536 - left slant */ 7 89 ) char (1) unaligned static options (constant); 7 90 7 91 /* END INCLUDE FILE comp_metacodes.incl.pl1 */ 1011 8 1 /* BEGIN INCLUDE FILE comp_shared.incl.pl1 */ 8 2 8 3 /* format: style2,ind2,ll79,dclind4,idind15,comcol41,linecom */ 8 4 8 5 dcl shared_version fixed bin (35) static options (constant) init (17); 8 6 8 7 dcl 1 shared aligned based (const.shared_ptr), 8 8 2 version fixed bin (35), /* version of this structure */ 8 9 2 chars, 8 10 ( 3 sym_delim, /* delimiter for symbols */ 8 11 3 ttl_delim, /* delimiter for title parts */ 8 12 3 wrd_brkr /* word break character */ 8 13 ) char (1) unal, 8 14 3 PAD char (1) unal, 8 15 2 cbar_type char (4) var, /* change bar type */ 8 16 2 dot_add_letter /* dot page add letter */ 8 17 char (1) var, 8 18 2 EN_width fixed bin (31), /* width of EN in current font */ 8 19 2 eqn_refct fixed bin, /* equation reference counter */ 8 20 2 footref_fcs /* footnote ref FCS string */ 8 21 char (8) aligned, 8 22 2 ftn_reset char (8) var, /* footnote reset mode */ 8 23 2 ftnrefct fixed bin, /* footnote ref counter */ 8 24 2 hyph_size fixed bin (31), /* least word part size for hyphing */ 8 25 2 if_nest, /* if/then/else logic control */ 8 26 3 ndx fixed bin, /* depth of logic nest */ 8 27 3 e (25), /* nest entries */ 8 28 /* .if control switch */ 8 29 4 sw fixed bin, /* 0=off, 1=(then), -1=(else) */ 8 30 4 info aligned like text_entry.info, 8 31 4 line char (256) var, /* the control line */ 8 32 2 indctl, /* indent ctls stack */ 8 33 3 ndx fixed bin, /* current level */ 8 34 /* switch bits */ 8 35 3 stk (0:35) bit (1) unal, 8 36 2 input_dirname 8 37 char (168) var, /* dir containing current input file */ 8 38 2 input_filename 8 39 char (200) var, /* current input file name */ 8 40 2 lead fixed bin (31), /* current linespacing value */ 8 41 2 lit_count fixed bin (35), /* count of literal lines */ 8 42 2 next_pagenmbr 8 43 char (32) var, /* next page number / */ 8 44 2 output_file 8 45 char (32) var, /* output file identifier */ 8 46 2 pagecount fixed bin, /* number of pages produced */ 8 47 2 pagenum, /* page number structure */ 8 48 3 index fixed bin, /* level currently counting */ 8 49 ( 8 50 3 sep char (1) unal, /* separator chars */ 8 51 3 nmbr fixed bin (31), /* the counters */ 8 52 3 mode /* display modes */ 8 53 fixed bin (8) unal 8 54 ) dimension (20), 8 55 2 parameter char (254) var, /* command line parameter */ 8 56 2 param_pres bit (1), /* passed parameter flag */ 8 57 2 pass_counter 8 58 fixed bin, /* pass counter */ 8 59 2 picture, /* picture blocks */ 8 60 3 count fixed bin, /* number of them */ 8 61 3 space fixed bin (31), /* total picture space */ 8 62 3 blk (10), /* picture blocks */ 8 63 4 type char (4), /* type = page/col */ 8 64 4 place char (4), /* place = top/cen/bot */ 8 65 4 ptr ptr, /* pointer to block */ 8 66 4 size fixed bin (31), /* size of the picture */ 8 67 2 ptrs, 8 68 ( 3 aux_file_data_ptr, /* -> auxiliary file data */ 8 69 3 blank_footer_ptr, /* -> blank page footer */ 8 70 3 blank_header_ptr, /* -> blank page header */ 8 71 3 blank_text_ptr, /* -> blank page text */ 8 72 3 blkptr, /* -> active text */ 8 73 3 colptr, /* current column */ 8 74 3 compout_ptr, /* iocb pointer for output */ 8 75 3 compx_ptr, /* iocb pointer for compx file */ 8 76 3 ctb_ptr, /* current line artwork table */ 8 77 3 epftrptr, /* even page footer block */ 8 78 3 ephdrptr, /* even page header block */ 8 79 3 fcb_ptr, /* input file control block pointer */ 8 80 3 ftnblk_data_ptr, /* footnote block data pointer */ 8 81 3 footnote_header_ptr, /* footnote header "title" */ 8 82 3 graphic_page_ptr, /* graphic output page */ 8 83 3 hit_data_ptr, /* hit data pointer */ 8 84 3 htab_ptr, /* horizontal tab tables */ 8 85 3 hwrd_data_ptr, /* local hyphenation table */ 8 86 3 insert_ptr, /* data entry for current input file */ 8 87 3 opftrptr, /* odd page footer block */ 8 88 3 ophdrptr, /* odd page header block */ 8 89 3 ptb_ptr, /* previous line artwork table */ 8 90 3 spcl_blkptr, /* "special" block pointer */ 8 91 3 tbldata_ptr, /* table column data structure */ 8 92 3 tblkdata_ptr, /* text block data array */ 8 93 3 text_header_ptr /* empty text header structure */ 8 94 ) ptr, 8 95 2 scale, /* space conversion scale factors */ 8 96 3 horz fixed bin (31), /* horizontal */ 8 97 3 vert fixed bin (31), /* vertical */ 8 98 2 source_filename 8 99 char (200) var, /* current source file name */ 8 100 2 sws, /* switch bits */ 8 101 ( 3 bug_mode, /* debug mode */ 8 102 3 compout_not_headed, /* compout is not headed */ 8 103 3 end_input, /* EOF for current input file */ 8 104 3 end_output, /* no more output is wanted */ 8 105 3 firstpass, /* first pass over input */ 8 106 3 ftn_mode, /* in footnote mode */ 8 107 3 hyph_mode, /* hyphenating mode */ 8 108 3 inserting_hfc, /* inserting hdr, ftr, or cap */ 8 109 3 literal_mode, /* literal line mode flag */ 8 110 3 pageblock, /* blocks belong to page */ 8 111 3 picture_mode, /* building a picture */ 8 112 3 print_flag, /* producing output */ 8 113 3 purge_ftns, /* purging footnotes */ 8 114 3 suppress_footref, /* suppress next footnote ref */ 8 115 3 table_mode /* table mode */ 8 116 ) bit (1) unal, 8 117 3 MBZ bit (21) unal, 8 118 2 trans, /* trans table for .tr */ 8 119 3 in char (128) var, /* input chars */ 8 120 3 out char (128) var, /* output chars */ 8 121 2 widow_size fixed bin (31), /* widow size */ 8 122 2 widow_foot fixed bin (31); /* widow for footnotes */ 8 123 /* to save shared data between files/passes */ 8 124 dcl 1 save_shared aligned like shared based (const.save_shared_ptr); 8 125 8 126 dcl dot_addltr_symb_index 8 127 fixed bin static options (constant) init (12); 8 128 dcl max_text_lines fixed bin static options (constant) init (1000); 8 129 dcl mode_string char (16) static options (constant) 8 130 init ("arbihxocalaurlru"); 8 131 /* value overlays */ 8 132 dcl flag_value bit (1) based; 8 133 dcl num_value fixed bin (31) based; 8 134 8 135 /* END INCLUDE FILE comp_shared.incl.pl1 */ 1012 9 1 /* BEGIN INCLUDE FILE comp_text.incl.pl1 */ 9 2 9 3 /* format: style2,ind2,ll79,dclind4,idind15,comcol41,linecom */ 9 4 9 5 dcl 1 tblkdata /* data for allocated text blocks */ 9 6 aligned based (shared.tblkdata_ptr), 9 7 2 block, /* block pool */ 9 8 3 count fixed bin, 9 9 3 ptr (500) ptr, /* block pointers */ 9 10 /* block state flags */ 9 11 3 free (500) bit (1) unal, 9 12 2 line_area, /* line area pool */ 9 13 3 count fixed bin, 9 14 3 ptr (500) ptr, /* area pointers */ 9 15 /* area state flags */ 9 16 3 free (500) bit (1) unal, 9 17 2 text_area, /* text area pool */ 9 18 3 count fixed bin, 9 19 3 ptr (500) ptr, /* area pointers */ 9 20 /* area state flags */ 9 21 3 free (500) bit (1) unal, 9 22 3 string_area_count 9 23 fixed bin; /* line areas */ 9 24 dcl LINE_AREA_SIZE fixed bin static options (constant) init (24); 9 25 dcl line_area_ptr ptr init (null); 9 26 dcl 1 line_area aligned based (line_area_ptr), 9 27 2 next ptr, /* forward thread */ 9 28 2 prev ptr, /* backward thread */ 9 29 2 count fixed bin, /* number of lines allocated */ 9 30 2 ndx fixed bin, /* index of current line */ 9 31 2 pndx fixed bin, /* area pool index */ 9 32 2 linptr (LINE_AREA_SIZE) ptr; 9 33 /* text areas */ 9 34 dcl TEXT_AREA_SIZE fixed bin static options (constant) init (6); 9 35 dcl text_area_ptr ptr init (null); 9 36 dcl 1 text_area aligned based (text_area_ptr), 9 37 2 next ptr, /* forward thread */ 9 38 2 count fixed bin, /* number of areas allocated */ 9 39 2 ndx fixed bin, /* index of current strarea */ 9 40 2 pndx fixed bin, /* area pool index */ 9 41 2 strareaptr (TEXT_AREA_SIZE) ptr; 9 42 /* text string area */ 9 43 dcl string_area (256) fixed bin based; 9 44 dcl txtstrptr ptr; /* current text string */ 9 45 dcl txtstr char (1020) var based (txtstrptr); 9 46 9 47 dcl TEXT_VERSION fixed bin static options (constant) init (9); 9 48 /* general text block */ 9 49 dcl 1 text aligned based (shared.blkptr), 9 50 2 version fixed bin, /* version of structure */ 9 51 2 blkndx fixed bin, /* block data index */ 9 52 2 blktype char (2), /* block type code */ 9 53 /* dynamic block control stuff */ 9 54 2 hdr aligned like text_header, 9 55 /* text read from input file */ 9 56 2 input aligned like text_entry, 9 57 2 input_line char (1020) var,/* input buffer */ 9 58 2 line_area, 9 59 3 first ptr, /* head of line area thread */ 9 60 3 cur ptr, /* current line area */ 9 61 2 next_text ptr, /* next text string */ 9 62 /* text formatting parameters */ 9 63 2 parms aligned like default_parms, 9 64 2 text_area, 9 65 3 first ptr, /* head of text area thread */ 9 66 3 cur ptr; /* current text area */ 9 67 /* an empty text block line */ 9 68 dcl 1 text_entry aligned based (const.text_entry_ptr), 9 69 2 sws, /* unaligned switches, etc. */ 9 70 3 art bit (1) unal, /* line has artwork */ 9 71 3 cbar, /* change bar flags */ 9 72 4 add bit (1) unal, /* text addition flag */ 9 73 4 del bit (1) unal, /* text deletion flag */ 9 74 4 mod bit (1) unal, /* text modification flag */ 9 75 3 default bit (1) unal, /* 1 = default case as needed */ 9 76 3 DVctl bit (1) unal, /* 1 = line is a device ctl string */ 9 77 3 embedded bit (1) unal, /* 1 = line has an embedded control */ 9 78 3 end_keep bit (1) unal, /* 1= line ends a keep */ 9 79 3 fnt_chng bit (1) unal, /* 1 = text is a font change string */ 9 80 3 footref bit (1) unal, /* 1 = line has a footnote reference */ 9 81 3 hanging bit (1) unal, /* 1 = a hanging undent */ 9 82 3 keep bit (1) unal, /* 1 = unsplittable line */ 9 83 3 no_trim bit (1) unal, /* 1 = untrimmable white line */ 9 84 3 oflo bit (1) unal, /* line causes overflow */ 9 85 3 punct bit (1) unal, /* 1 = line ends with punctuation */ 9 86 3 quad bit (6) unal, /* text alignment flags */ 9 87 3 space_added /* 1= line has added space */ 9 88 bit (1) unal, 9 89 3 spcl, /* special entry - not output text */ 9 90 4 file bit (1) unal, /* 1= output to special file */ 9 91 4 blk_splt /* 1= action at block split time */ 9 92 bit (1) unal, 9 93 4 page_mkup /* 1= action at page makeup time */ 9 94 bit (1) unal, 9 95 3 table bit (1) unal, /* 1= line is a table entry */ 9 96 3 tblspc bit (1) unal, /* 1= WS fill for table mode */ 9 97 3 title bit (1) unal, /* 1= line is a