contrib/hdtbl/hdmisc.tmac

   1 .\"     -*-     mode: roff      -*-
   2 .ig
   3
   4 hdmisc.tmac
   5
   6 This file is part of groff, the GNU roff type-setting system.
   7
   8 Copyright (C) 2005, 2006 Free Software Foundation, Inc.
   9 written by Joachim Walsdorff <Joachim.Walsdorff@urz.uni-heidelberg.de>.
  10
  11 groff is free software; you can redistribute it and/or modify it under
  12 the terms of the GNU General Public License as published by the Free
  13 Software Foundation; either version 2, or (at your option) any later
  14 version.
  15
  16 groff is distributed in the hope that it will be useful, but WITHOUT
  17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  18 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  19 for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with groff; see the file COPYING.  If not, write to the Free
  23 Software Foundation, 51 Franklin St - Fifth Floor, Boston, MA
  24 02110-1301, USA.
  25
  26 ..
  27 .
  28 .
  29 .\" %beginstrip%
  30 .
  31 .if d getarg \
  32 .  nx
  33 .
  34 .
  35 .\"     ******************************************************************
  36 .\"     **      Some macros and default settings needed by hdtbl        **
  37 .\"     ******************************************************************
  38 .
  39 .
  40 .\"     Utility macro:  .getarg <key> ...
  41 .\"
  42 .\"             Get macro argument.  This macro searches <key> in the
  43 .\"             remaining arguments and assigns its value to a string
  44 .\"             register named <key>.  The following syntax forms are
  45 .\"             recognized.
  46 .\"
  47 .\"                     <key>=<val>     Assign <val> to string <key>.
  48 .\"                                     <val> must not contain spaces.
  49 .\"                     <key>='<val>'   Assign <val> to string <key>.
  50 .\"                                     <val> can contain spaces.
  51 .\"                     <key>=          Assign `=' to string <key>.
  52 .\"                     <key>           Assign `key' to string <key>.
  53 .\"
  54 .\"             After return, the string `args' contains the remaining
  55 .\"             arguments.
  56 .\"
  57 .\"             Example: With the definition of string `foo' as
  58 .\"
  59 .\"                     .ds foo aaa=xxx bbb ccc='yyy zzz' ddd= eee
  60 .\"
  61 .\"             a call to `getarg' with
  62 .\"
  63 .\"                     .getarg ccc \*[foo]
  64 .\"
  65 .\"             sets string `ccc' to value `yyy zzz'.  The string `args'
  66 .\"             now contains `aaa=xxx bbb ddd= eee'.  An additional call
  67 .\"             like
  68 .\"
  69 .\"                     .getarg ddd \*[args]
  70 .\"
  71 .\"             sets string `ddd' to value `=', and `args' contains
  72 .\"             `aaa=xxx bbb eee'.
  73 .de getarg
  74 .  ds \\$1
  75 .  ds args
  76 .
  77 .  if (\\n[.$] < 2) \
  78 .    return
  79 .
  80 .  ds $1 \\$1\"
  81 .  shift
  82 .
  83 .  length * \\*[$1]
  84 .  while \\n[.$] \{\
  85 .    ds * "\\$1\"
  86 .    ds ** "\\$1\"
  87 .    length ** \\*[**]
  88 .    shift
  89 .    if (\\n[*] > \\n[**]) \{\
  90 .      as args " "\\*[**]"\"                    value too short, repeat
  91 .      continue
  92 .    \}
  93 .    substring * 0 (\\n[*] - 1)
  94 .    \" The surrounding \? escapes emulate string comparison.
  95 .    ie !"\?\\*[$1]\?"\?\\*[*]\?" \{\
  96 .      as args " "\\*[**]"\"                    key not found, repeat
  97 .      continue
  98 .    \}
  99 .    el \{\
 100 .      ie "\?\\*[**]\?"\?\\*[$1]\?" \
 101 .        ds \\*[$1] \\*[$1]\"                   return key as string
 102 .      el \{\
 103 .        ie "\?\\*[**]\?"\?\\*[$1]=\?" \
 104 .          ds \\*[$1] =\"                       return `='
 105 .        el \{\
 106 .          substring ** (\\n[*] + 1) -1
 107 .          ds * \\*[**]\"
 108 .          substring * 0 0
 109 .
 110 .          \" check whether value starts with quote
 111 .          if "\?\\*[*]\?"\?'\?" \{\
 112 .            substring ** 1 -1
 113 .            ds * \\*[**]\"
 114 .            substring * -1 -1
 115 .
 116 .            \" search final quote
 117 .            ie "\?\\*[*]\?"\?'\?" \
 118 .              substring ** 0 -2
 119 .            el \{\
 120 .              as \\*[$1] \\*[**] \"            not found, append argument
 121 .
 122 .              while 1 \{\
 123 .                ds ** \\$1\"                   get next argument
 124 .                ds * \\$1\"
 125 .                shift
 126 .                substring * -1 -1
 127 .
 128 .                if "\?\\*[*]\?"\?'\?" \{\
 129 .                  substring ** 0 -2
 130 .                  break                \"      break if no final quote
 131 .                \}
 132 .
 133 .                as \\*[$1] \\*[**] \"          otherwise append and repeat
 134 .              \}
 135 .          \}\}
 136 .
 137 .          as \\*[$1] \\*[**]\"
 138 .        \}
 139 .
 140 .        as args " \\$@\"
 141 .    \}\}
 142 .
 143 .    return
 144 .  \}
 145 ..
 146 .
 147 .
 148 .\"     Utility macro:  .index <string1> <string2>
 149 .\"
 150 .\"             Check whether <string2> is a substring of <string2> and
 151 .\"             return its position in number register `index', starting
 152 .\"             with 1.  If not found, return 0.  If <string2> is empty,
 153 .\"             set `index' to -999.
 154 .de index
 155 .  if "\\$2"" \{\
 156 .    nr index -999
 157 .    return
 158 .  \}
 159 .
 160 .  length ** \\$1\a
 161 .  length $2 \\$2
 162 .  nr * 0-1 1
 163 .
 164 .  while (\\n+[*] < \\n[**]) \{\
 165 .    ds * \\$1\a\"
 166 .    substring * \\n[*] (\\n[*] + \\n[$2] - 1)
 167 .    \" The surrounding \? escapes emulate string comparison.
 168 .    if "\?\\*[*]\?"\?\\$2\?" \
 169 .      break
 170 .  \}
 171 .
 172 .  ie (\\n[*] == \\n[**]) \
 173 .    nr index 0
 174 .  el \
 175 .    nr index (\\n[*] + 1)
 176 ..
 177 .
 178 .
 179 .\"     ******************************************************************
 180 .\"     ********        non-accumulating space .SP [v]          **********
 181 .\"     **                                                              **
 182 .\"     **      nl vor erster Seite -1, oben auf Seite 0 resp. tH       **
 183 .\"     **      .k nach .sp oder .br 0,                                 **
 184 .\"     **              sonst Laenge der angefangenen Zeile             **
 185 .\"     **      Der Merker M# fuer vorangegangenes .SP wird in .HM am   **
 186 .\"     **      Seitenanfang zurueckgesetzt.                            **
 187 .\"     **      ganz richtig ist .sp + .br = .br + .sp = .sp            **
 188 .\"     ******************************************************************
 189 .de SP
 190 .  if (\\n[nl] < 0) \
 191 .    br                 \"      start very first page
 192 .  nr * \\n[.p]         \"      save current page length
 193 .
 194 .  ie "\\$1"" \
 195 .    pl +1              \"      without arg increase page length by 1v
 196 .  el \
 197 .    pl +\\$1           \"      otherwise use \\$1
 198 .
 199 .  nr ** (\\n[.p] - \\n[*])     \" ** now holds arg for .SP in base units
 200 .  pl \\n[*]u           \"      restore page length
 201 .
 202 .  \" we do nothing at start of new page or column
 203 .  if ((\\n[nl] - \\n[tH]) & (\\n[nl] - \\n[<<]) : \\n[.k]) \{\
 204 .    ie ((\\n[.d] - \\n[M#]) : \\n[.k]) \{\
 205 .      sp \\n[**]u      \"      execute .sp
 206 .      nr S# \\n[**]    \"      store ** in S#
 207 .    \}
 208 .    el \{\
 209 .      if (\\n[**] - \\n[S#]) \{\
 210 .        sp (\\n[**]u - \\n[S#]u)\"     emit difference to previous .SP
 211 .        nr S# \\n[**]  \"      store ** in S#
 212 .    \}\}
 213 .
 214 .    nr M# \\n[.d]      \"      store vertical position .d in M#
 215 .  \}
 216 ..
 217 .
 218 .
 219 .\"     ******************************************************************
 220 .\"     **              Perform all arguments once                      **
 221 .\"     **                      P1 is nestable                          **
 222 .\"     ******************************************************************
 223 .de P1
 224 .  \" `while' command is about five times faster than recursion!
 225 .  while \\n[.$] \{\
 226 .    nop \\$1
 227 .    shift
 228 .  \}
 229 ..
 230 .
 231 .
 232 .\"     ******************************************************************
 233 .\"     **      Hilfsmakro zum Einstellen von Schriftgroesse und        **
 234 .\"     **      Zeilenabstand, bezogen auf Anfangswerte \n[s] und \n[v] **
 235 .\"     **      sowie fuer Hyphenation:                                 **
 236 .\"     **              .pv s v hy# hart;  macht .br                    **
 237 .\"     **      Bei 4. Argument setzen der Register s und v und hy.     **
 238 .\"     **      Fuer angefangene Zeile die vorgefundenen Einstellungen  **
 239 .\"     ******************************************************************
 240 .de pv
 241 .  br
 242 .
 243 .  if \\n[.$] \
 244 .    ps (\\n[s]u * \\$1z / 1z)
 245 .
 246 .  ie (\\n[.$] - 1) \
 247 .    vs (\\n[v]u * \\$2p / 1p)
 248 .  el \{\
 249 .    vs (\\n[v]u * \\$1p / 1p)
 250 .    return
 251 .  \}
 252 .
 253 .  if !""\\$3" \
 254 .    hy \\$3
 255 .
 256 .  if !""\\$4" \{\
 257 .    nr v \\n[.v]
 258 .    nr s \\n[.ps]
 259 .    nr hy \\n[.hy]
 260 .  \}
 261 ..
 262 .
 263 .
 264 .\"     ******************************************************************
 265 .\"     **              Hilfsmakros pop/pops/popr (pop stackelement):   **
 266 .\"     **              pop or popr:    pop register                    **
 267 .\"     **              pops:           pop string                      **
 268 .\"     **              .pop[s|r] reg|string stackname                  **
 269 .\"     **                  reg|string: name of reg/string to get the   **
 270 .\"     **                       popped element                         **
 271 .\"     **                  stack: name of stack                        **
 272 .\"     ******************************************************************
 273 .de *pop
 274 .  ie "\\$1"pops" \
 275 .    ds \\$2 \\$4\"             pop first stackelement
 276 .  el \
 277 .    nr \\$2 \\$4
 278 .
 279 .  ds $3 \\$3\"                 remember stackname
 280 .  shift 4              \"      shift four args
 281 .
 282 .  ds \\*[$3] "\\$@\"           fill stack with remaining elements
 283 ..
 284 .
 285 .de pop
 286 .  *pop \\$0 \\$1 \\$2 \\*[\\$2]
 287 ..
 288 .
 289 .als popr pop
 290 .als pops pop
 291 .
 292 .
 293 .\"     ******************************************************************
 294 .\"     **              processs diversion                              **
 295 .\"     ******************************************************************
 296 .de DI
 297 .  nr * \\n[.u]
 298 .  nf           \"      diversion is already formatted - output it unchanged
 299 .  \\$1         \"      output the diversion ...
 300 .  rm \\$1      \"      ... and remove it
 301 .  if \\n[*] \
 302 .    fi         \"      reactivate formatting
 303 ..
 304 .
 305 .
 306 .\"     ******************************************************************
 307 .\"     **      Some macros and the page setup used by the examples     **
 308 .\"     ******************************************************************
 309 .
 310 .\"     ******************************************************************
 311 .\"     **      some of the following macros use system commands        **
 312 .\"     **      and are therefore `unsafe': they need the `-U' argument **
 313 .\"     **      when calling groff/troff                                **
 314 .\"     ******************************************************************
 315 .
 316 .\"     ******************************************************************
 317 .\"     **              Header macro for the examples                   **
 318 .\"     ******************************************************************
 319 .de H
 320 .  nr *w* (17 * \w\a\\$*\a / 10 + 4n)
 321 .  TBL border=1n \
 322        bc=yellow \
 323        bgc=red4 \
 324        fgc=yellow \
 325        csp=0 \
 326        fst=TB \
 327        "fsz=1.7 1.5" \
 328        hal=c \
 329        tal=c \
 330        "width=(\\n[*w*]+4n)<?\n[.l]"
 331 .  TR .TD
 332 .  P1 \\$*
 333 .  ETB
 334 .  SP
 335 ..
 336 .
 337 .
 338 .\"     ******************************************************************
 339 .\"     **      Utility macro for the date, requires UNIX date.         **
 340 .\"     **      after return string *date contains the date in the      **
 341 .\"     **      standard form of the Unix date-command,                 **
 342 .\"     **      for example "Sun Dec  5 22:27:57     2004"              **
 343 .\"     ******************************************************************
 344 .de date
 345 .  pso bash -c "echo -n .ds *date\ ;date"
 346 .  tm \\*[*date] ***
 347 ..
 348 .
 349 .
 350 .\"     ******************************************************************
 351 .\"     **      Utility macro for time measurement, requires UNIX date  **
 352 .\"     **      .time s[tart]|[end]                                     **
 353 .\"     **              .time start:                                    **
 354 .\"     **                      reg *time gets the start-time (seconds) **
 355 .\"     **              .time [end]:                                    **
 356 .\"     **                      reg *time gets the difference of the    **
 357 .\"     **                              end- and start-time (seconds)   **
 358 .\"     ******************************************************************
 359 .de time
 360 .  ds * \\$1\"
 361 .  substring * 0 0
 362 .  ie "\\*[*]"s" \
 363 .    pso bash -c "echo -n .nr *time 0+;date +%s"
 364 .  el \{\
 365 .   pso bash -c "echo -n .nr *time -;date +%s"
 366 .   nr *time 0-\\n[*time]
 367 .   tm elapsed time: \\n[*time] seconds
 368 .  \}
 369 ..
 370 .
 371 .
 372 .\"     ******************************************************************
 373 .\"     **              Perform n-times all the arbitrary arguments     **
 374 .\"     **              .PN n a2 a3 ...                                 **
 375 .\"     **                      PN is nestable                          **
 376 .\"     ******************************************************************
 377 .de PN
 378 .  nr *pn +1
 379 .  nr PN\\n[*pn] (\\$1 + 1) 1
 380 .  shift
 381 .
 382 .  while \\n-[PN\\n[*pn]] \
 383 .    P1 \\$@
 384 .
 385 .  nr *pn -1
 386 ..
 387 .
 388 .
 389 .\"     Utility macro:  .d2x decimal_number [base [string_name]]
 390 .\"
 391 .\"             Convert `decimal_number' to another base `base' (in the
 392 .\"             range 1..16) and store the result in string `string_name'.
 393 .\"             If `base' is missing or empty, convert to a hexadecimal
 394 .\"             number.  If `string_name' is missing or empty, return value
 395 .\"             in string `hex#', otherwise return the value in both
 396 .\"             `string_name' and `hex#'.
 397 .\"
 398 .\"             The base value 1 is handled specially: The returned
 399 .\"             string contains the character `|' `decimal_number' times
 400 .\"             (for example, input value 4 yields `||||').
 401 .ds d2x-0 0\"
 402 .ds d2x-1 1\"
 403 .ds d2x-2 2\"
 404 .ds d2x-3 3\"
 405 .ds d2x-4 4\"
 406 .ds d2x-5 5\"
 407 .ds d2x-6 6\"
 408 .ds d2x-7 7\"
 409 .ds d2x-8 8\"
 410 .ds d2x-9 9\"
 411 .ds d2x-10 A\"
 412 .ds d2x-11 B\"
 413 .ds d2x-12 C\"
 414 .ds d2x-13 D\"
 415 .ds d2x-14 E\"
 416 .ds d2x-15 F\"
 417 .
 418 .
 419 .de d2x
 420 .  if !\B\a\\$1\a \{\
 421 .    tm \\n[.F]:\\n[.c]: invalid or missing first argument
 422 .    tm1 "     usage: `.d2x decimal_number [base [string_name]]'
 423 .    return
 424 .  \}
 425 .
 426 .  nr i# (-1) 1
 427 .  nr j# 1
 428 .  ds hex#
 429 .  nr dec# (\\$1) 1
 430 .
 431 .  if !\\$1 \
 432 .    nr dec# (-\\n[dec#])
 433 .
 434 .  ie !"\\$2"" \{\
 435 .    ie !\B\a\\$2\a \
 436 .      tm \\n[.F]:\\n[.c]: invalid base `\\$2'
 437 .    el \
 438 .      ie ((\\$2 < 1) : (\\$2 > 16)) \
 439 .        tm \\n[.F]:\\n[.c]: invalid base `\\$2'
 440 .      el \
 441 .        nr b# \\$2
 442 .  \}\}
 443 .  el \
 444 .    nr b# 16
 445 .
 446 .  nr xb# 1
 447 .
 448 .  ie (\\n[b#] == 1) \{\
 449 .    nr dec# +1
 450 .    while \\n-[dec#] \
 451 .      as hex# |\"
 452 .  \}
 453 .  el \{\
 454 .    while (\\n[dec#] - \\n[xb#]) \{\
 455 .      nr xb# (\\n[xb#] * \\n[b#])
 456 .      nr j# +1
 457 .    \}
 458 .
 459 .    while (\\n+[i#] < \\n[j#]) \{\
 460 .      nr ** (\\n[dec#] / \\n[xb#])
 461 .      as hex# \\*[d2x-\\n[**]]\"
 462 .      nr dec# (\\n[dec#] - (\\n[xb#] * \\n[**]))
 463 .      nr xb# (\\n[xb#] / \\n[b#])
 464 .    \}
 465 .  \}
 466 .
 467 .  \" strip leading zero, if any
 468 .  ds * \\*[hex#]\"
 469 .  substring * 0 0
 470 .  if "\\*[*]"0" \
 471 .    substring hex# 1 -1
 472 .
 473 .  if (\\$1 < 0) \
 474 .    ds hex# -\\*[hex#]\"
 475 .
 476 .  if !"\\$3"" \{\
 477 .    ie !\A\a\\$3\a \
 478 .      tm \\n[.F]:\\n[.c]: invalid string name `\\$3'
 479 .    el \
 480 .      ds \\$3 \\*[hex#]\"
 481 .  \}
 482 ..
 483 .
 484 .
 485 .\"     Utility macro:  .random#
 486 .\"                     .random-seed seed1 seed2
 487 .\"
 488 .\"             Return pseudo-random numbers in the range 0..0xFFFFFF,
 489 .\"             represented as the concatenation of `#' and six
 490 .\"             hexadecimal digits, in the string `#random'.  The
 491 .\"             macro `random-seed' can be used to set seed values,
 492 .\"             which should be integers in the range 1..2147483562 and
 493 .\"             1..2147483398 for `seed1' and `seed2', respectively
 494 .\"             (the macro applies a modulo operation to assure this
 495 .\"             range).  If `random-seed' isn't called the registers
 496 .\"             `seconds', `minutes', `hours', `dy', `mo', `year', and
 497 .\"             `$$' are used to compute it.
 498 .\"
 499 .\"             The used generator is presented in L'Ecuyer's 1988 paper
 500 .\"             `Efficient and Portable Combined Random Number
 501 .\"             Generators', which combines two Multiplicative Linear
 502 .\"             Congruential Generators (MLCGs) to achieve a period of
 503 .\"             2.3*10^18.
 504 .af hours 00
 505 .af minutes 00
 506 .af seconds 00
 507 .af year 0000
 508 .af mo 00
 509 .af dy 00
 510 .
 511 .ds random-s1 \n[minutes]\n[seconds]\n[$$]\n[hours]\"
 512 .\" prevent overflow
 513 .substring random-s1 0 8
 514 .
 515 .nr random-s1 (\*[random-s1] % 2147483562)
 516 .nr random-s2 \n[dy]\n[year]\n[mo]
 517 .
 518 .
 519 .de random-seed
 520 .  if !(\\n[.$] == 2) \{\
 521 .    tm1 "random-seed: Invalid number of arguments.
 522 .    tm1 "             usage: `.random-seed seed1 seed2'
 523 .    return
 524 .  \}
 525 .
 526 .  nr random-s1 (\\$1 % 2147483562)
 527 .  nr random-s2 (\\$2 % 2147483398)
 528 ..
 529 .
 530 .
 531 .de random#
 532 .  nr * (\\n[random-s1] / 53668)
 533 .  nr random-s1 (40014 * (\\n[random-s1] - (\\n[*] * 53668)) \
 534                 - (\\n[*] * 12211))
 535 .  if !\\n[random-s1] \
 536 .    nr random-s1 +2147483563
 537 .
 538 .  nr * (\\n[random-s2] / 52774)
 539 .  nr random-s2 (40692 * (\\n[random-s2] - (\\n[*] * 52774)) \
 540                 - (\\n[*] * 3791))
 541 .  if !\\n[random-s2] \
 542 .    nr random-s2 +2147483399
 543 .
 544 .  nr * (\\n[random-s1] - \\n[random-s2])
 545 .  if (\\n[*] < 1) \
 546 .    nr * +2147483562
 547 .
 548 .  \" reduce the result to the leftmost 24 bits
 549 .  nr * (\\n[*] / 128)
 550 .
 551 .  d2x \\n[*]
 552 .  ds hex# 000000\\*[hex#]\"
 553 .  substring hex# -6
 554 .  ds #random #\\*[hex#]\"
 555 ..
 556 .
 557 .
 558 .\"     ******************************************************************
 559 .\"     **                      minimal Page setup                      **
 560 .\"     ******************************************************************
 561 .
 562 .nr s \n[.ps]
 563 .nr v \n[.v]
 564 .pv 1.2 1.2 "" X
 565 .nr l 6.6i                              \"      set text width
 566 .ll \n[l]u
 567 .nr o 2c                                \"      set offset
 568 .po \n[o]u
 569 .nr p 29.7c                             \"      set paper length (A4)
 570 .pl \n[p]u
 571 .nr tH 1i                               \"      set top margin
 572 .sp |\n[tH]u
 573 .
 574 .ev 99
 575 .lt \n[l]u
 576 .ev
 577 .
 578 .
 579 .de HM
 580 .  sp |.5i                              \"      print header in top margin
 581 .  tl \\*[t*HM]
 582 .  sp |\\n[tH]u
 583 .  ev
 584 ..
 585 .
 586 .
 587 .de BM
 588 .  ev 99
 589 .  sp |(\\n[p]u - .5i)                  \"      print footer in bottom margin
 590 .  tl \\*[t*BM]
 591 .  bp
 592 ..
 593 .
 594 .
 595 .de EM
 596 .  rm BM                        \"      no page number at bottom of last page
 597 .
 598 .  if !"\\*[t*kept]"" \{\
 599 .    tm1 "hdtbl: Not all tables have been printed.
 600 .    tm1 "       Add `.bp' at the end of your document.
 601 .  \}
 602 .  if !"\\*[t*held]"" \{\
 603 .    tm1 "hdtbl: There are held tables which haven't been printed.
 604 .    tm1 "       Add `.t*free' at the end of your document.
 605 .  \}
 606 .  if \\n[t*#] \
 607 .    tm hdtbl: Missing `.ETB' macro at end of document.
 608 ..
 609 .
 610 .
 611 .em EM
 612 .
 613 .if "\n[.m]"" \
 614 .  gcolor black
 615 .if "\n[.M]"" \
 616 .  fcolor white
 617 .
 618 .mso hdtbl.tmac\"                       load table macros
 619 .
 620 .\" EOF