#!/usr/local/bin/sciteco -m
!* grosciteco.tes [-t <output-tec>] [--] <output-woman> <input> *!

0,2EJ !* FIXME: Memory limiting is too slow *!

:EMQ[$SCITECOPATH]/getopt.tes

!* Process command-line options *!
[optstring]t: M[getopt]"F (0/0) '
LR 0X[output-woman] 2LR 0X[input] HK
:Q[getopt.t]"< EU[getopt.t]Q[output-woman].tec '

EBN[input]
0EE !* Groff intermediate code is always ASCII *!

!* skip whitespace characters *!
@#sw{
  <0A-^^ "N 1; ' :C;>
}

!* skip N (string) arguments beginning with current one *!
@#sa{
  "~1'<
    <0A-^^ "= 1; ' 0A-10"= 1; ' :C;> :M#sw
  >
}

!* get next integer argument, skipping it *!
@#gi{
  \ (0A-^^-"= :C ' <0A"D :C; | 1; '> :M#sw)
}

!* skip end of command *!
@#sc{
  0A-10"= :C '
}

0U[text.lines] 0U[pos.v] 0U[pos.h]

!* move to (pos.h,pos.v) relative to origin, making space if necessary *!
@[move]{ [.n
  U.n J
  Q[pos.v]-Q[text.lines]">
    ZJ Q[pos.v]-Q[text.lines]<I^J>
    Q[pos.v]U[text.lines]
  |
    Q[pos.v]L
  '
  Q[pos.h]<.-Z"= I  | 0A-10"= I  | C' '>
  Q.n<.-Z"= 1; ' 0A-10"= 1; ' D>
].n }

!* draw a line to (h,v) *!
!* FIXME: Works only for straight lines *!
@[line]{ U.[to.v] U.[to.h]
  Q.[to.h]-Q[pos.h]"= Q.[to.v]-Q[pos.v]"=  ' '
  [* EB
  Q.[to.h]-Q[pos.h]"=
    !* vertical line *!
    Q.[to.v]-Q[pos.v]"< Q[pos.v]U.v Q.[to.v]U[pos.v] | Q.[to.v]U.v '
    1:M[move] %[pos.v] .-Z"= I R '
    -A-9472"= 0A-9472"= I┬ | I┐ '
            | 0A-9472"= I┌ | I╷ ' '
    Q.v-Q[pos.v]<
      1:M[move] %[pos.v] .-Z"= I R '
      -A-9472"= 0A-9472"= I┼ | I┤ '
              | 0A-9472"= I├ | I│ ' '
    >
    1:M[move] .-Z"= I R '
    -A-9472"= 0A-9472"= I┴ | I┘ '
            | 0A-9472"= I└ | I╵ ' '
    Q.[to.v]U[pos.v]
  |
    !* horizontal line
       FIXME: works only if horizonal lines are drawn first. *!
    Q.[to.h]-Q[pos.h]"< Q[pos.h]U.h Q.[to.h]U[pos.h] | Q.[to.h]U.h '
    Q.h-Q[pos.h]+1<
      1:M[move] I─ %[pos.h]
    >
    Q.[to.h]U[pos.h]
  '
  ]*
}

!* style last N glyphs/characters *!
1U[default-style]
@[style]{ [.l
  U.l Q[font]-Q[default-style]"N
    .-Q.lU.l Q.lESSTARTSTYLING Q[font],(-Q.l)ESSETSTYLING
  '
].l }

[topics]

!* special characters *!
[glyphs.**]∗
[glyphs.\-]-
[glyphs.aa]'
[glyphs.aq]'
[glyphs.dq]"
[glyphs.hy]‐
[glyphs.ha]^
[glyphs.em]—
[glyphs.bu]•
[glyphs.pc]·
[glyphs.la]⟨
[glyphs.ra]⟩
[glyphs.lq]“
[glyphs.rq]”
[glyphs.Fo]«
[glyphs.Fc]»
[glyphs.rs]\
[glyphs.ti]~
[glyphs.+]+
[glyphs.->]→
[glyphs.tm]™

!* process formatter commands *!
@[format]{ <
  .-Z"= 1; '
  0AU[cmd] C
  Ocmd.U[cmd]

  !cmd.x!
    :M#sw
    0AU[cmd] C
    Ocmd.xU[cmd]

    !cmd.xT!
      2:M#sa :M#sc F<
    !cmd.xr!
      :M#sa :M#giU[res] :M#giU[res.h] :M#giU[res.v] :M#sc F<
    !cmd.xi!
      :M#sa :M#sc F<
    !cmd.xF!
      L F<
    !cmd.xX!
      :M#sw .(W).X.w
      Ocmd.xXQ.w
      !cmd.xXsciteco_topic!
        !*
         * FIXME: The buffer position of this topic might still
         * change due to movement commands (esp. when formatting
         * a table). Only the line+column should no longer change.
         * Either store line+column or use markers.
         *!
        [* EB 0:M[move] U.d ]*
        :EU[topics]\.d:
        C :X[topics]
        L F<
      !cmd.xXsciteco_tt!
        [* EB 0:M[move] U[ttstart] ]*
        L F<
      !cmd.xXsciteco_tt_end!
        [* EB 0:M[move]
          -Q[ttstart]<
            Q[ttstart]ESSTARTSTYLING Q[ttstart]ESGETSTYLEAT+16,1ESSETSTYLING
          %[ttstart]>
        ]*
        L F<
      !cmd.xXsciteco_startstyling!
        [* EB 0:M[move] U[stylestart] ]*
        L F<
      !cmd.xXsciteco_setstyling!
        C :M#giU.s
        [* EB 0:M[move]
          Q[stylestart]ESSTARTSTYLING Q.s,(-Q[stylestart])ESSETSTYLING
        ]*
        L F<
      !cmd.xXtty!
      !cmd.xXdevtag!
        L F<

    !cmd.xf!
      :M#sa :M#giU.n Q.n+16U.#nt .(:M#sa).X[font] :M#sc
      :Q[fonts.\.n]"F F< ' -U[fonts.\.n]
      @:EU[styles]{\.#ntESSTYLESETFONTMonospace^J}
      Ocmd.xfQ[font]
      !cmd.xfR!
        Q.nU[default-style]
        @:EU[styles]{16ESSTYLESETFONTMonospace^J}
        F<
      !cmd.xfB!
        @:EU[styles]{1,\.nESSTYLESETBOLD 1,\.#ntESSTYLESETBOLD^J}
        F<
      !cmd.xfBI!
        @:EU[styles]{1,\.nESSTYLESETBOLD 1,\.#ntESSTYLESETBOLD^J}
      !cmd.xfI!
        @:EU[styles]{1,\.nESSTYLESETITALIC 1,\.#ntESSTYLESETITALIC^J}
        @:EU[styles]{0EJ-1"= 1,\.nESSTYLESETUNDERLINE 1,\.#ntESSTYLESETUNDERLINE '^J}
        F<

    !cmd.xt!
      :M#sa :M#sc F<
    !cmd.xs!
      1;

  !cmd.F!
    L F<

  !cmd.p!
    :M#sw :M#gi Q[pos.v]U[origin.v] :M#sc F<

  !cmd.f!
    :M#sw :M#giU[font] :M#sc F<

  !cmd.s!
    :M#sw :M#gi :M#sc F<

  !cmd.V!
    :M#sw :M#gi/Q[res.v]-1+Q[origin.v]U[pos.v] :M#sc F<

  !cmd.v!
    :M#sw :M#gi/Q[res.v]%[pos.v] :M#sc F<

  !cmd.H!
    :M#sw :M#gi/Q[res.h]U[pos.h] :M#sc F<

  !cmd.h!
    :M#sw :M#gi/Q[res.h]%[pos.h] :M#sc F<

  !cmd.m!
    :M#sw
    0AU[cmd] C
    Ocmd.mU[cmd]

    !cmd.md!
      :M#sc F<

  !cmd.D!
    :M#sw
    0AU[cmd] C
    Ocmd.DU[cmd]

    !cmd.DF!
      :M#sw
      0AU[cmd] C
      Ocmd.DFU[cmd]

        !cmd.DFd!
          :M#sc F<

        !cmd.DFg!
          :M#sw :M#gi :M#sc F<

    !cmd.Dl!
      :M#sw :M#gi/Q[res.h]+Q[pos.h]U.[to.h] :M#gi/Q[res.v]+Q[pos.v]U.[to.v] :M#sc
      Q.[to.h],Q.[to.v]M[line] F<

    !cmd.Dp!
    !cmd.DP!
      :M#sw Q[pos.h]U.[start.h] Q[pos.v]U.[start.v]
      <
        :M#gi/Q[res.h]U.h Q.h+Q[pos.h]U.[to.h] :M#gi/Q[res.v]U.v Q.v+Q[pos.v]U.[to.v]
        Q.h%.[inc.h] Q.v%.[inc.v]
        Q.[to.h],Q.[to.v]M[line]
        0A-10"= 1; '
      >
      Q.[start.h],Q.[start.v]M[line]
      Q.[inc.h]%[pos.h] Q.[inc.v]%[pos.v]
      :M#sc F<

    !cmd.Dt!
      :M#sw :M#gi/Q[res.h]%[pos.h] :M#sw :M#gi :M#sc F<

  !cmd.t!
    :M#sw .(:M#sa).X.w
    [* EB :Q.w:M[move]
    G.w :Q.w:M[style] ]*
    :Q.w%[pos.h] :M#sc F<

  !cmd.C!
    :M#sw 0A-^^u"=
      !* FIXME: This can be CuXXXX_XXXX (decomposed, eg. for cyrillic й) *!
      C 16 \U.w  W
    |
      .(:M#sa).X.w 0Q[glyphs.Q.w]U.w
    '
    [* EB 1:M[move]
    Q.wI 1:M[style] ]* :M#sc F<

  !cmd.c!
    :M#sw 0AU.w C
    [* EB 1:M[move]
    G[glyphs.U.w] 1:M[style] ]* :M#sc F<

  !cmd.N!
    :M#sw :M#giU.w
    [* EB 1:M[move]
    Q.wI 1:M[style] ]* :M#sc F<

  !cmd.n!
    :M#sw :M#gi :M#gi :M#sc F<

  !cmd.w!
    :M#sc F<
> }

!*
 * Inline local macro invocations in [format]
 * This speeds up runtime by 25%
 *!
EQ[format]
  J<FR:M[move]Q[move];>
  J<FR:M[style]Q[style];>
  J<FR:M#saQ#sa;>
  J<FR:M#giQ#gi;>
  J<FR:M#swQ#sw;>
  J<FR:M#scQ#sc;>
  !*
   * Compress whitespace, kind of dangerous:
   * J<FRS ;>
   *!
Q*U*

:M[format]

!*
 * Generate the styling instructions based on the styles
 * of the womanpage buffer. The styles are configured according
 * to their font positions (already in `styles`).
 * Styles are NOT generated in `styles` immediately during
 * formatting, since the buffer positions of text to style
 * can still change with `move` operations that add whitespace.
 * Also, here we can generate a minimal list of styling operations
 * ending up with much smaller *.tec files.
 * TODO: The size can still be improved by using SCI_SETSTYLINGEX
 * if appropriate.
 *!
EB 0EE !* operate in single-byte mode *!
J 0U#cs 0U#cd
<
  .ESGETSTYLEATUs Qs"< Qs= '
  .-Z"< Qs-Q#cs"= C F< ' '
  Q#cs"N
    .-Q#cd Ul
    @:EU[styles]{\#cdESSTARTSTYLING \#cs,\lESSETSTYLING^J}
  '
  QsU#cs .U#cd
:C;>

!*
 * Save the clear-text part of the document into <output-woman>
 *!
2EL EWQ[output-woman]

EQ[styles]

!* Generate topic index *!
J I!*Q[topics]*!^J

2EL EWQ[getopt.t]

-EX