home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / list / ep-src.ark / GSTR.MAC < prev    next >
Text File  |  1988-05-21  |  19KB  |  1,395 lines

  1.     include    BDSYM.EQU
  2.     include    EPDATA
  3.  
  4.     .request SENDIT
  5. ;    .request JUSTIFY now with prtsbuf
  6.     .request UNDERLI
  7.  
  8.     .comment    `
  9. functions GSTR
  10. (also internal COLUMNCHK, GPASS)
  11.  
  12.  
  13. /************************************************/
  14. /************************************************/
  15. columnchk()
  16. {
  17.     /* if not in multiple column mode, proceed normally    */
  18.     if (!(nc || cc)) return(FALSE);
  19.  
  20.     /* when all columns ready, print whole line        */
  21.     if (cc >= nc || !nc)
  22.     {    outpoint += outbuf - xoutbuf;
  23.         outbuf = xoutbuf;
  24.         attrbuf = xattrbuf;
  25.         widbuf = xwidbuf;
  26.         return(FALSE);
  27.     }
  28.  
  29.     /* otherwise, ready put next line into next column    */
  30.     gotocol(llength + ir + gu);
  31.     outbuf += outpoint;
  32.     attrbuf += outpoint;
  33.     widbuf += outpoint;
  34.     /* save mode of previous column                */
  35.     brcstk[cc][brcpt[cc]++] = mode;
  36.     cc++;
  37.     /* restore mode for next column                */
  38.     modepop();
  39.     newoutline();
  40.     return(TRUE); 
  41. }
  42.             `
  43.  
  44. columnchk:
  45.  
  46. ;    /* if not in multiple column mode, proceed normally    */
  47. ;    if (!(nc || cc)) return(FALSE);
  48.  
  49.  
  50.     lda    nc
  51.     mov    l,a
  52.     lda    cc
  53.     mov    h,a
  54.     ora    l
  55.     jnz    $+7
  56.     shld    mcoloffset    ;global used in setting rule ends
  57.     ret
  58.  
  59. ;
  60. ;    /* when all columns ready, print whole line        */
  61. ;    if (cc >= nc || !nc)
  62.  
  63. ;if nc 0, print
  64.     mov    a,l
  65.     ora    a
  66.     jz    .clchk2
  67. ;nc (in A) > cc (in H)?
  68.     dcr    a
  69.     cmp    h
  70.     jnc    .clchk3
  71.  
  72. ;    {    outpoint += outbuf - xoutbuf;
  73. .clchk2:
  74.     lxi    h,0
  75.     shld    mcoloffset
  76.  
  77.     lhld    outbuf
  78.     lxi    d,xoutbuf
  79.     call    cmd
  80.     dad    d
  81.  
  82.     xchg
  83.     lhld    outpoint
  84.     dad    d
  85.     shld    outpoint
  86.  
  87. ;        outbuf = xoutbuf;
  88.     lxi    h,xoutbuf
  89.     shld    outbuf
  90.  
  91. ;        attrbuf = xattrbuf;
  92.     lxi    h,xattrbuf
  93.     shld    attrbuf
  94.  
  95. ;        widbuf = xwidbuf;
  96.     lxi    h,xwidbuf
  97.     shld    widbuf
  98.  
  99. ;        return(FALSE);
  100. ;    }
  101.     xra    a
  102.     ret
  103. ;
  104.  
  105. ;    /* otherwise, ready put next line into next column    */
  106. ;    gotocol(llength + ir + gu);
  107. .clchk3:
  108.     lhld    llength
  109.  
  110.     xchg
  111.     lhld    ir
  112.     dad    d
  113.  
  114.     xchg
  115.     lhld    gu
  116.     dad    d
  117.  
  118.     push    h    ;pass to gotocol
  119.     xchg
  120.     lhld    mcoloffset
  121.     dad    d
  122.     shld    mcoloffset
  123.  
  124.     call    gotocol##
  125.     pop    d
  126.  
  127. ;    outbuf += outpoint;
  128. ;    attrbuf += outpoint;
  129. ;    widbuf += outpoint;
  130.  
  131.     lhld    outpoint
  132.     xchg
  133.  
  134.     lhld    outbuf
  135.     dad    d
  136.     shld    outbuf
  137.  
  138.     xchg    ;next are word arrays
  139.     dad    h
  140.     xchg
  141.     
  142.     lhld    attrbuf
  143.     dad    d
  144.     shld    attrbuf
  145.  
  146.     lhld    widbuf
  147.     dad    d
  148.     shld    widbuf
  149.  
  150. ;    /* save mode of previous column                */
  151. ;    brcstk[cc][brcpt[cc]++] = mode;
  152.  
  153.     call    pshbrc
  154.  
  155. ;    cc++;
  156. ;;    lhld    cc
  157. ;;    inx    h
  158. ;;    shld    cc
  159.     lxi    h,cc
  160.     inr    m
  161.  
  162. ;    /* restore mode for next column                */
  163. ;    modepop();
  164. ;    newoutline();
  165.     call    modepop##
  166. ;    call    newoutline##
  167.     call    nnewout
  168.  
  169. ;    return(TRUE); 
  170. ;}
  171.     mvi    a,1
  172.     ora    a
  173.     ret
  174.  
  175.  
  176.     .comment    `
  177. /************************************************/
  178. /* Output a line of characters            */
  179. /************************************************/
  180.  
  181. int gsti, tness;
  182. char tripleh;
  183.  
  184. gstr()
  185. {
  186.     /* if no characters, just go down one line    */
  187.     if (!outpoint && outbuf == xoutbuf)
  188.     {    if (columnchk()) return;
  189.         skdots += PICA + sl;
  190.         newoutline();
  191.         return;
  192.     }
  193.  
  194.     if (outpoint) justify();
  195.  
  196.     if (columnchk()) return;
  197.  
  198.     if (fa && unidir)
  199.     {    PTESCCH('U');
  200.         PTCH('0');
  201.         unidir = FALSE;
  202.     }
  203.     else
  204.     if (grfflag ^ unidir)
  205.     {    PTESCCH('U');
  206.         if (grfflag) PTCH('1'); else PTCH('0');
  207.         unidir = grfflag;
  208.     }
  209.  
  210.     tripleh = (cheight >= (3 * PICA));
  211.  
  212.     if (tallflag && cheight != (3 * PICA))
  213.     {    
  214.         tness = (cheight <= PICA || duplflag) ? (2 * PICA) : cheight;
  215.  
  216.         if (tness < (2 * PICA))
  217.         {    gsti = (2 * PICA) - tness;
  218.             if (skdots >= gsti) skdots -= gsti; 
  219.         }
  220.         else if (tripleh)
  221.         {    gsti = PICA - (tness % PICA) - sl;
  222.             if (gsti > 0 && skdots >= gsti) skdots -= gsti; 
  223.         }
  224.  
  225.         paperup(tness - PICA + 3);
  226.  
  227.         tabottom = FALSE;
  228.  
  229.         if (tripleh)
  230.         {    if (tness > (5*PICA))    gpass(0);
  231.             if (tness > (4*PICA))    gpass(1);
  232.                         gpass(2);
  233.         }
  234.         else
  235.         {    if (tness > (PICA + 2))    gpass(0);
  236.             if (tness > (PICA + 1))    gpass(1);
  237.             if (tness > PICA)    gpass(2);
  238.             skdots += PICA - 4;
  239.         }
  240.  
  241.     }
  242.     else if (tallflag) paperup(3 * PICA);
  243.     else paperup(3);
  244.  
  245.     tabottom = TRUE;
  246.  
  247.     nativeline();
  248.     gpass(0);
  249.     gpass(1);
  250.     gpass(2);
  251.  
  252.     if (cheight < PICA)
  253.         skdots += cheight - 4;
  254.     else    skdots += PICA - 4;
  255.  
  256.     skdots += sl;
  257.  
  258.     /* reset pointers, etc.        */
  259.     if (nc && cc >= nc)
  260.     {    brcstk[cc][brcpt[cc]++] = mode;
  261.         cc = 1;
  262.         modepop();
  263.     }
  264.     if (!nc) cc = 0;
  265.     newoutline();
  266. }
  267.  
  268.             `
  269.  
  270. gstr::
  271.  
  272.  
  273. ;    /* if no characters, just go down one line    */
  274. ;    if (!outpoint && outbuf == xoutbuf)
  275.  
  276.     lhld    outpoint
  277.     mov    a,h
  278.     ora    l
  279.     jnz    .gs2
  280.  
  281. ;flag new paragraph
  282.     lxi    h,val + 54*('P'-'@') + 2*('P'-'@')
  283.     inr    m
  284.  
  285.     lhld    outbuf
  286.     xchg
  287.     lxi    h,xoutbuf
  288.     call    eqwel
  289.     jnz    .gs2
  290.  
  291. ;    {    if (columnchk()) return;
  292.     call    columnchk
  293.     rnz
  294.  
  295. ;        skdots += PICA + sl;
  296. .gs1:
  297. ;use paragraph-spacing
  298. ;    lhld    sl
  299. ;    lxi    d,PICA
  300. ;    dad    d
  301.  
  302. ;RULES!
  303.  
  304.     lhld    val + 54*('P'-'@') + 2*('S'-'@')
  305.  
  306.     call    docvrule
  307.  
  308. ;;    xchg
  309. ;;    lhld    skdots
  310. ;;    dad    d
  311. ;;    shld    skdots
  312. ;        newoutline();
  313. ;        return;
  314. ;    }
  315.     jmp    newoutline##
  316.  
  317. ;
  318. ;    if (outpoint) justify();
  319. .gs2:    lhld    outpoint
  320.     mov    a,h
  321.     ora    l
  322.     cnz    justify##
  323. ;
  324. ;    if (columnchk()) return;
  325.     call    columnchk
  326.     rnz
  327.  
  328. ;
  329. ;    if (fa && unidir)
  330. .gs4:
  331.     push    b
  332. ;henceforth C = tness
  333.  
  334.     lda    fa
  335.     ora    a
  336.     jz    .gs5
  337.     lda    unidir
  338.     ora    a
  339.     jz    .gs5
  340.  
  341. ;    {    PTESCCH('U');
  342. ;        PTCH('0');
  343. ;        unidir = FALSE;
  344. ;    }
  345.     mvi    a,'U'
  346.     call    presc1##
  347.     mvi    a,'0'
  348.     call    pr1##
  349.     xra    a
  350.     sta    unidir
  351.     jmp    .gs8
  352.  
  353. ;    else
  354. ;    if (grfflag ^ unidir)
  355. .gs5:    lda    grfflag
  356.     mov    l,a
  357.     lda    unidir
  358.     xra    l
  359.     jz    .gs8
  360. ;    {    PTESCCH('U');
  361. ;        if (grfflag) PTCH('1'); else PTCH('0');
  362.  
  363.     mvi    a,'U'
  364.     call    presc1##
  365.  
  366. ;    lda    grfflag
  367.     mov    a,l
  368.     sta    unidir    ;cf. below
  369.     ora    a
  370.     mvi    a,'1'
  371.     jnz    .gs6
  372. ;;    mvi    a,'0'
  373.     dcr    a
  374. .gs6:    call    pr1##
  375.  
  376. ;        unidir = grfflag;
  377. ;    }
  378. ;    lda    grfflag
  379. ;    sta    unidir
  380.  
  381. ;
  382. ;    tripleh = (cheight >= (3 * PICA));
  383. .gs8:
  384.     lhld    cheight
  385.     shld    _savheight
  386.     lda    duplflag
  387.     ora    a
  388. ;    jz    .gs8b    
  389. ;10/86 change
  390.     jz    .gs8a
  391.     mvi    e,1
  392.     call    shlrbe
  393.     mov    a,l
  394.     cpi    PICA+1    ;was 2 * PICA
  395.     mvi    a,0
  396.     jc    .gs8a
  397.     shld    cheight
  398.     inr    a
  399.     inr    a
  400. .gs8a:    sta    tduplex
  401.  
  402. .gs8b:    lda    cheight
  403.     cpi    3 * PICA
  404.     mvi    a,0
  405.     sta    afterdup
  406.     jc    .gs8e
  407.     inr    a
  408. .gs8e:    sta    tripleh
  409.  
  410. ;
  411. ;    if (tallflag && cheight != (3 * PICA))
  412. ;    {    
  413.     lda    tallflag
  414.     ora    a
  415.     jz    .gs22
  416.     lda    cheight
  417.     cpi    3 * PICA
  418.     jz    .gs22
  419.  
  420. ;        tness = (cheight <= PICA || duplflag) ? (2 * PICA) : cheight;
  421.     mvi    h,2 * PICA    ;min val
  422.     mov    l,a    ;(cheight)
  423.     cpi    PICA + 1
  424.  
  425. ;(it turns out we do want duplex < 16p high)
  426.     jc    .gs9
  427.  
  428.     lda    tduplex
  429.     ora    a
  430.     jnz    .gs11
  431.  
  432.     lda    duplflag
  433.     ora    a
  434.     jz    .gs11
  435. ;back up (16p - cheight)/2
  436.     mov    a,h
  437.     sub    l
  438.     ora    a
  439.     jm    .gs9
  440.     rar
  441.     sta    afterdup
  442.     add    l
  443.     mov    h,a
  444. .gs9:    mov    l,h    ;(2 * PICA)
  445. .gs11:    mov    c,l
  446. ;
  447. ;        if (tness < (2 * PICA))
  448.     mov    a,c
  449.     cmp    h    ;(2 * PICA)
  450.     jnc    .gs13
  451.  
  452. ;        {    gsti = (2 * PICA) - tness;
  453. ;            if (skdots >= gsti) skdots -= gsti; 
  454. ;        }
  455.  
  456.     mov    a,h
  457.     sub    l
  458.     mov    e,a
  459.     mvi    d,0
  460. ;DE = (2 * PICA) - tness
  461.     call    cmd
  462.     lhld    skdots
  463.     dad    d
  464. ;if >= 0, is new skdots
  465.     mov    a,h
  466.     ora    a
  467.     jm    .gs14
  468.     jmp    .gs13a    ;go store in skdots
  469.  
  470. ;        else if (tripleh)
  471. .gs13:    lda    tripleh
  472.     ora    a
  473.     jz    .gs14
  474.  
  475. ;        {    gsti = PICA - (tness % PICA) - sl;
  476. ;(L = tness)
  477.     mvi    h,0
  478.     lxi    d,pica
  479.     xchg
  480.     call    smod
  481. ;HL = tness % PICA
  482.     xchg
  483.     lhld    sl
  484.     dad    d
  485.     call    cmh
  486. ;HL = - (tness % PICA) - sl
  487.     lxi    d,PICA
  488.     dad    d
  489.  
  490. ;            if (gsti > 0 && skdots >= gsti) skdots -= gsti; 
  491. ;        }
  492. ;(ok if 0)
  493.     mov    a,h
  494.     ora    a
  495.     jm    .gs14
  496.     xchg
  497.     call    cmd
  498.     lhld    skdots
  499.     dad    d
  500. ;HL = skdots - "gsti"
  501.  
  502.     mov    a,h
  503.     ora    a
  504.     jm    .gs14
  505. .gs13a:    shld    skdots
  506.  
  507.  
  508. ;
  509. ;        paperup(tness - PICA + 3);
  510. .gs14:
  511.  
  512.     mov    l,c
  513.     mvi    h,0
  514.     lxi    d,- PICA + 3
  515.     dad    d
  516.     push    h
  517.     call    paperup##
  518.     pop    d
  519. ;
  520. ;        tabottom = FALSE;
  521.     xra    a
  522.     sta    tabottom
  523. ;
  524. ;        if (tripleh)
  525.     lda    tripleh
  526.     ora    a
  527.     jz    .gs17
  528.  
  529. ;        {    if (tness > (5*PICA))    gpass(0);
  530.     mov    a,c
  531.     cpi    5*PICA + 1
  532.     jc    .gs15
  533.     xra    a
  534.     call    gpass
  535. ;            if (tness > (4*PICA))    gpass(1);
  536. .gs15:
  537.     mov    a,c
  538.     cpi    4*PICA + 1
  539.     jc    .gs16
  540.     mvi    a,1
  541.     call    gpass
  542. ;                        gpass(2);
  543. ;        }
  544. .gs16:    mvi    a,2
  545.     call    gpass
  546.     jmp    .gs21
  547. ;        else
  548. ;        {    if (tness > (PICA + 2))    gpass(0);
  549. .gs17:
  550.     mov    a,c
  551.     cpi    PICA + 2 + 1
  552.     jc    .gs18
  553.     xra    a
  554.     call    gpass
  555. ;            if (tness > (PICA + 1))    gpass(1);
  556. .gs18:
  557.     mov    a,c
  558.     cpi    PICA + 1 + 1
  559.     jc    .gs19
  560.     mvi    a,1
  561.     call    gpass
  562. ;            if (tness > PICA)    gpass(2);
  563. .gs19:
  564.     mov    a,c
  565.     cpi    PICA + 1    
  566.     jc    .gs20
  567.     mvi    a,2
  568.     call    gpass
  569. ;            skdots += PICA - 4;
  570. ;        }
  571. ;
  572. ;    }
  573. .gs20:    lhld    skdots
  574.     lxi    d,PICA - 4
  575.     dad    d
  576.     shld    skdots
  577. .gs21:    jmp    .gs24
  578.  
  579. ;    else if (tallflag) paperup(3 * PICA);
  580. .gs22:    lda    tallflag
  581.     ora    a
  582.     lxi    h,3
  583.     jz    .gs23
  584.  
  585.     lxi    h,3*PICA
  586. ;    else paperup(3);
  587. .gs23:    push    h
  588.     call    paperup##
  589.     pop    d
  590. ;
  591. ;    tabottom = TRUE;
  592. .gs24:
  593.     mvi    a,1
  594.     sta    tabottom
  595. ;
  596. ;    nativeline();
  597. ;    gpass(0);
  598. ;    gpass(1);
  599. ;    gpass(2);
  600.  
  601.     call    inover##
  602. .gs24.1:
  603.     lxi    d,-PICA
  604.     dad    d
  605.     mov    a,h
  606.     ora    a
  607.     jm    .gs24.2
  608.     push    h
  609.     mvi    a,' '
  610.     call    termput##
  611.     pop    h
  612.     jmp    .gs24.1
  613. .gs24.2:
  614.     call    nativeline##
  615.  
  616.     xra    a
  617.     call    gpass
  618.     mvi    a,1
  619.     call    gpass
  620.     mvi    a,2
  621.     call    gpass
  622.  
  623. ;
  624. ;    if (cheight < PICA)
  625.     lhld    skdots
  626.     xchg
  627.     lxi    h,PICA - 4
  628. ;*** change this, since cheight may > 255 with big duplex chars ***
  629.     lda    cheight
  630.     cpi    PICA+1
  631. ;;    jnc    .gs25
  632.     jc    .gs25.1
  633.     lda    duplflag
  634.     ora    a
  635.     jz    .gs25.3
  636.     lda    afterdup
  637.     cma
  638.     inr    a
  639.     add    l
  640.     jmp    .gs25.2
  641.  
  642. ;$afterdup:    db    0
  643. ;$_savheight:    dw    0
  644. ;$tduplex:    db    0
  645.  
  646. .gs25.1:
  647. ;        skdots += cheight - 4;
  648.     dcr    a
  649.     dcr    a
  650.     dcr    a
  651.     dcr    a
  652. .gs25.2:
  653.     mov    l,a
  654. ;HL = cheight - 4
  655.  
  656. ;    else    skdots += PICA - 4;
  657. .gs25.3:
  658.     dad    d
  659. ;
  660. ;    skdots += sl;
  661. ;.gs26:
  662.  
  663. ;;    xchg
  664.  
  665. ;interline RULES!
  666.  
  667. ;;    lhld    sl
  668. ;;    dad    d
  669.     shld    skdots
  670.  
  671.  
  672. ;for lines with duplex characters > 16 points high,
  673. ; do all passes twice, once with tduplex=2, then with tduplex=1
  674.  
  675.     lxi    h,tduplex
  676.     dcr    m
  677.     jm    $+6
  678.     jnz    .gs8b
  679.  
  680.     lhld    _savheight
  681.     shld    cheight
  682.  
  683.  
  684.  
  685.     lhld    sl
  686.     call    docvrule
  687.  
  688. ;
  689. ;    /* reset pointers, etc.        */
  690. ;    if (nc && cc >= nc)
  691.     lda    nc
  692.     ora    a
  693.     jz    .gs27
  694.     mov    l,a
  695.     lda    cc
  696.     cmp    l
  697.     jc    .gs27
  698.  
  699. ;    {    brcstk[cc][brcpt[cc]++] = mode;
  700.  
  701.     call    pshbrc
  702.  
  703. ;        cc = 1;
  704. ;        modepop();
  705. ;    }
  706.     lxi    h,1
  707.     shld    cc
  708.  
  709.     call    modepop##
  710.  
  711. ;    if (!nc) cc = 0;
  712. .gs27:    lda    nc
  713.     ora    a
  714.     jnz    .gs28
  715.     lxi    h,0
  716.     shld    cc
  717.  
  718. ;    newoutline();
  719. ;}
  720. .gs28:
  721.     call    nnewout
  722.     pop    b
  723.     ret
  724.  
  725. nnewout:
  726.     lda    nospec
  727.     ora    a
  728.     jnz    newoutline##
  729.  
  730.     lxi    h,0
  731.     shld    val + 54*('P'-'@') + 2*('P'-'@')
  732.     shld    val + 54*('L'-'@') + 2*('A'-'@')
  733.     shld    val + 54*('U'-'@') + 2*('N'-'@')
  734.     shld    val + 54*('I'-'@') + 2*('L'-'@')
  735.     jmp    newoutline##
  736.  
  737. pshbrc::
  738.     lhld    cc
  739.     lxi    d,12
  740.     call    usmul
  741.     lxi    d,brcstk
  742.     dad    d
  743.     push    h
  744.  
  745.     lhld    cc
  746.     dad    h
  747.     lxi    d,brcpt
  748.     dad    d
  749.     mov    e,m
  750.     inx    h
  751.     mov    d,m
  752.     inx    d
  753.     mov    m,d
  754.     dcx    h
  755.     mov    m,e
  756.     dcx    d
  757.     xchg
  758.  
  759.     dad    h
  760.     pop    d
  761.     dad    d
  762.  
  763.     xchg
  764.     lhld    mode
  765.     xchg
  766.     mov    m,e
  767.     inx    h
  768.     mov    m,d
  769.     ret
  770.  
  771.  
  772. ;gsti:        dw    0 not used
  773. ;tness:        dw    0 kept in C
  774. ;$tripleh:    db    0
  775.  
  776.  
  777.  
  778.     .comment    `
  779. /************************************************/
  780. /* Do one of three passes necessary to print    */
  781. /*    a line of graphics characters        */
  782. /************************************************/
  783. gpass(pass)
  784. int pass;
  785. {
  786.  
  787.     if (!grfflag || (fa && pass != 1))
  788.     {    skdots++;    return;        }
  789.  
  790.  
  791.     /* assume no dots        */ 
  792.     gpoint = 0;
  793.     setmem(gbuf, 2000, 0);
  794.  
  795.     /* store the dots for each character    */
  796.     for (gsti = 0; gsti < outpoint; gsti++) gchr(gsti, pass);
  797.  
  798.     /* kern for possible italic in last col & right trim    */
  799.     while (gbuf[gpoint++] || gbuf[gpoint++]);
  800.     while (gpoint >= 0 && !gbuf[gpoint]) gpoint--;
  801.     gpoint++;
  802.  
  803.     /* underlining goes in 2nd row of dots from bottom    */
  804.     if (pass == 2 && tabottom) underline();
  805.  
  806.     /* now send it out    */
  807.     sendit();
  808.  
  809.     if (tripleh)
  810.     {    sendit();
  811.         sendit();
  812.         skdots += PICA - 4;
  813.     }
  814. }
  815.  
  816.             `
  817.  
  818. gpass:
  819. ;(made internal with arg 'pass' in A)
  820. ;    pop    d
  821. ;    pop    h
  822. ;    push    h
  823. ;    push    d
  824. ;
  825. ;    mov    a,l
  826.     sta    _gpass
  827.  
  828.     push    b
  829.  
  830. ;    if (!grfflag || (fa && pass != 1))
  831.  
  832.     lda    grfflag
  833.     ora    a
  834.     jz    .gp1
  835.  
  836.     lda    fa
  837.     ora    a
  838.     jz    .gp2
  839.  
  840.     lda    _gpass
  841.     dcr    a
  842.     jz    .gp2
  843. ;    {    skdots++;    return;        }
  844. ;
  845. .gp1:    lhld    skdots
  846.     inx    h
  847.     shld    skdots
  848.     pop    b
  849.     ret
  850. ;
  851. ;    /* assume no dots        */ 
  852. ;    gpoint = 0;
  853. .gp2:
  854. ;;    lxi    h,0
  855. ;;    shld    gpoint
  856. ;zeroing of gbuf and (gpoint) now done in dohrule
  857.  
  858. ;signal this is not an interline call
  859.     xra    a
  860.     call    dohrule
  861.  
  862. ;
  863. ;    /* store the dots for each character    */
  864. ;    for (gsti = 0; gsti < outpoint; gsti++) gchr(gsti, pass);
  865. ;BC = gsti
  866.     lxi    b,0
  867.  
  868. .gp3:
  869.     mov    d,b
  870.     mov    e,c
  871.     lhld    outpoint
  872.     call    albs
  873.     jnc    .gp4
  874.  
  875.     lda    _gpass
  876.     mov    l,a
  877.     mvi    h,0
  878.     push    h
  879.     push    b
  880.     call    gchr##
  881.     pop    d
  882.     pop    d
  883.  
  884.     inx    b
  885.     jmp    .gp3
  886. ;
  887. ;    /* kern for possible italic in last col & right trim    */
  888. ;    while (gbuf[gpoint++] || gbuf[gpoint++]);
  889. ;BC = gpoint
  890. .gp4:
  891.     lxi    h,GBUFSIZ-1
  892.  
  893. ;;;    lhld    gpoint
  894.     mov    b,h
  895.     mov    c,l
  896.     lxi    d,gbuf
  897.     dad    d
  898. ;;;.gp5:
  899.  
  900. ;;;    mov    a,m
  901. ;;;    inx    h
  902. ;;;    inx    b
  903. ;;;    ora    a
  904. ;;;    jnz    .gp5
  905.  
  906. ;;;    mov    a,m
  907. ;;;    inx    h
  908. ;;;    inx    b
  909. ;;;    ora    a
  910. ;;;    jnz    .gp5
  911.  
  912. ;    while (gpoint >= 0 && !gbuf[gpoint]) gpoint--;
  913.  
  914. .gp6:
  915. ;BC = gpoint
  916.     mov    a,b
  917.     ral
  918.     jc    .gp7
  919.  
  920.     mov    a,m
  921.     ora    a
  922.     jnz    .gp7
  923.  
  924.     dcx    h
  925.     dcx    b
  926.     jmp    .gp6
  927.  
  928. ;    gpoint++;
  929. .gp7:    inx    b
  930.     mov    h,b
  931.     mov    l,c
  932.     shld    gpoint    ;(underline & sendit use gpoint)
  933. ;
  934. ;    /* underlining goes in 2nd row of dots from bottom    */
  935. ;    if (pass == 2 && tabottom) underline();
  936.     lda    _gpass
  937.     cpi    2
  938.     jnz    .gp8
  939.     lda    tduplex
  940.     cpi    2
  941.     jz    .gp8
  942.  
  943.     lda    tabottom
  944.     ora    a
  945.     cnz    underline##
  946. ;
  947. ;    /* now send it out    */
  948. ;    sendit();
  949. .gp8:
  950.     call    bumpgpt
  951.  
  952.     call    sendit##
  953.  
  954. ;
  955. ;    if (tripleh)
  956. ;    {    sendit();
  957. ;        sendit();
  958. ;        skdots += PICA - 4;
  959. ;    }
  960.     pop    b
  961.     lda    tripleh
  962.     ora    a
  963.     rz
  964.     lda    tallflag
  965.     ora    a
  966.     rz
  967.     call    sendit##
  968.     call    sendit##
  969.  
  970.     lda    tduplex
  971.     cpi    2
  972.     jnz    .gpnnx
  973.     lda    _gpass
  974.     cpi    2
  975.     jnz    .gpnnx
  976.     lda    cheight
  977.     cpi    3 * PICA
  978.     rz
  979.  
  980. .gpnnx:
  981.     lhld    skdots
  982.     lxi    d,PICA - 4
  983.     dad    d
  984.     shld    skdots
  985.     ret
  986. ;}
  987. .gpX:    pop    b
  988.     ret
  989.  
  990.  
  991. ;in case there was a rule drawn, maybe increase gpoint
  992. bumpgpt::
  993.     lhld    maxgpt
  994.     xchg
  995.     lhld    gpoint
  996.     call    albu
  997.     rc
  998.     xchg
  999.     shld    gpoint
  1000.     ret
  1001.  
  1002. clrgbuf::
  1003. ;init maxgpt (for last of last rule)
  1004.     call    inover##
  1005.     shld    gpoint
  1006.     lxi    h,0
  1007.     shld    maxgpt
  1008.  
  1009. ;    setmem(gbuf, 2000, 0);
  1010.  
  1011.     mov    e,l    ;(0)
  1012.     lxi    h,gbuf
  1013.     lxi    b,GBUFSIZ
  1014. .gp2a:    mov    m,e
  1015.     inx    h
  1016.     dcx    b
  1017.     mov    a,b
  1018.     ora    c
  1019.     jnz    .gp2a
  1020.     ret
  1021.  
  1022. ;$_gpass:        db    0
  1023. ;$maxgpt:        dw    0
  1024. ;$nvdots:        db    0
  1025.  
  1026.  
  1027. dohrule:
  1028.     sta    nvdots
  1029.  
  1030.     call    clrgbuf
  1031.  
  1032. ;examine each rule to see if it's defined and horizontal
  1033.     mvi    b,NUMRULES
  1034.     lxi    h,rulist-2
  1035.     lda    nospec
  1036.     ora    a
  1037.     jz    .dhr0
  1038.     mvi    b,NUMRULES-24
  1039.     lxi    h,rulist + 4*24 - 2
  1040. .dhr0:    inx    h
  1041.     inx    h
  1042. .dhr1:    dcr    b    ;looked at all possible rules?
  1043.     rm
  1044. ;examine left endpoint
  1045.     mov    a,m
  1046.     inx    h
  1047.     ora    m
  1048.     mov    a,m
  1049.     inx    h
  1050.     jz    .dhr0    ;no rule here
  1051. ;here's a rule, but is it horizontal?
  1052. ;if b15, we left a mark meaning vertical rule has been started
  1053.     ani    80h
  1054.     jz    .dhr1.1
  1055. ;save rulist  pointer for return to loop
  1056.     push    h
  1057. ;get the endpoint (without b15)
  1058.     push    h
  1059.     dcx    h
  1060.     mov    a,m
  1061.     ani    7fh
  1062.     mov    d,a
  1063.     dcx    h
  1064.     mov    e,m
  1065. ;assume solid, for continuing
  1066.     mvi    c,0ffh
  1067. ;get back pointer to test second word
  1068.     pop    h
  1069.  
  1070. ;check not interline
  1071.     lda    nvdots
  1072.     ora    a
  1073.     jz    .dhr1.1b
  1074.  
  1075. ;here it's a continuing interline vertical
  1076. ;calculate dot pattern from nvdots requested
  1077.     mov    l,a
  1078.     mvi    a,80h
  1079.     call    vdotpat
  1080.     mov    c,a
  1081.     jmp    .dhr1.1c
  1082. ;one dot at top for every 3 dots of skip (at least one)
  1083. vdotpat:
  1084.     dcr    l
  1085.     rz
  1086.     dcr    l
  1087.     rz
  1088.     dcr    l
  1089.     rz
  1090.     rm
  1091.     rar
  1092.     ori    80h
  1093.     jmp    vdotpat
  1094.  
  1095. .dhr1.1b:
  1096. ;test second word at HL
  1097.     mov    a,m
  1098.     inx    h
  1099.     ora    m
  1100.     jz    .dhr1.1c
  1101. ;don't terminate verticals in tops of tall characters
  1102.     lda    tabottom
  1103.     ora    a
  1104.     jz    .dhr1.1c
  1105. ;if something else was put there, terminate the v. rule
  1106.     mvi    c,0f0h    ;top only
  1107. ;(but shouldn't we wait 'til third pass?? ((if not fast)))
  1108.     lda    _gpass
  1109.     cpi    2
  1110.     jnz    .dhr1.1c
  1111.     xra    a
  1112.     mov    m,a
  1113.     dcx    h
  1114.     mov    m,a
  1115.     dcx    h
  1116.     mov    m,a
  1117.     dcx    h
  1118.     mov    m,a
  1119. .dhr1.1c:
  1120. ;check no tops or bottoms flag
  1121.     lda    val + 54*('R'-'@') + 2*('H'-'@') + 1
  1122.     ani    2
  1123.     cz    vdotset
  1124.  
  1125.     pop    h
  1126.     jmp    .dhr0
  1127.  
  1128. .dhr1.1:
  1129. ;don't do any horizontals or start verticals if interline
  1130.     lda    nvdots
  1131.     ora    a
  1132.     jnz    .dhr0
  1133. ;likewise if not tabottom
  1134.     lda    tabottom
  1135.     ora    a
  1136.     jz    .dhr0
  1137.     
  1138. ;examine right endpoint to see if it's a horizontal
  1139.     mov    a,m
  1140.     inx    h
  1141.     ora    m
  1142.     inx    h
  1143.     jnz    .dhr1.2
  1144. ;here we want to start a new vertical
  1145.     push    h
  1146.  
  1147.     dcx    h
  1148.     dcx    h
  1149.  
  1150.     dcx    h
  1151.  
  1152.     lda    fa
  1153.     dcr    a
  1154.     jz    $+8
  1155.     lda    _gpass
  1156.     cpi    2
  1157.     mov    a,m
  1158.     mov    d,a
  1159. ;mark as started
  1160. ;(but don't mark on pass 0,1 else will look continuing on pass 1,2)
  1161.     jnz    $+5
  1162.     ori    80h
  1163.     mov    m,a
  1164.     dcx    h
  1165.     mov    e,m
  1166. ;check no tops or bottoms flag
  1167.     lda    val + 54*('R'-'@') + 2*('H'-'@') + 1
  1168.     ani    2
  1169.     jnz    $+8
  1170.     mvi    c,0fh
  1171.     call    vdotset
  1172.  
  1173. ;loop
  1174.     pop    h
  1175.     jmp    .dhr1
  1176.  
  1177. ;called by draw with acc = num of dots
  1178. vvdotset::
  1179.     push    b
  1180.     jmp    $+7
  1181. vdotset:
  1182.     push    b
  1183.     lda    val + 54*('R'-'@') + 2*('V'-'@')
  1184.     mov    b,a
  1185.  
  1186. .vds1:
  1187.     call     sublind
  1188.     jnc    .vdsx
  1189.  
  1190.     mov    a,m
  1191.     ora    c
  1192.     mov    m,a
  1193.  
  1194. ;;    inx    d
  1195.     inx    d
  1196.     dcr    b
  1197.     jp    .vds1
  1198.     pop    b
  1199.     jmp    notemxg
  1200. .vdsx:    pop    b
  1201.     ret
  1202.  
  1203.  
  1204. sublind:
  1205.     lxi    h,gbuf
  1206.     dad    d
  1207.     push    h
  1208. ;check offset of corrected endpoint
  1209.     lxi    h,GBUFSIZ
  1210.     call    albu
  1211.     pop    h
  1212.     ret
  1213.  
  1214.  
  1215.  
  1216. .dhr1.2:
  1217. ;check thick flag
  1218.     lda    val + 54*('R'-'@') + 2*('H'-'@') + 1
  1219.     ani    1
  1220.     jnz    $+10
  1221.     lda    _gpass
  1222.     dcr    a
  1223.     jnz    .dhr1
  1224.  
  1225. ;yes, here we have one horizontal to do
  1226. ; save rulist pointer and count
  1227.  
  1228.     push    b
  1229.     push    h
  1230.  
  1231.  
  1232. ;get back right endpoint and undefine
  1233.     xra    a
  1234.     dcx    h
  1235.     mov    d,m
  1236.     mov    m,a
  1237.     dcx    h
  1238.     mov    e,m
  1239.     mov    m,a
  1240.     push    d
  1241. ;now left
  1242.     dcx    h
  1243.     mov    d,m
  1244.     mov    m,a
  1245.     dcx    h
  1246.     mov    e,m
  1247.     mov    m,a
  1248. ;get back right
  1249.     pop    h
  1250. ;and save left
  1251.     push    d
  1252. ;sigh, ...save right now
  1253.     push    h
  1254. ;how long is it? that's: right - left
  1255.     call    cmd
  1256.     dad    d
  1257. ;and this is the count
  1258.     mov    b,h
  1259.     mov    c,l
  1260. ;use right to set maximal rule point
  1261. ;note maximal rule dot
  1262.     pop    d
  1263.  
  1264. ;too big?
  1265.     call     sublind
  1266. ;;    lxi    h,GBUFSIZ
  1267. ;;    call    albu
  1268.     jc    $+7
  1269.     pop    d    ;bad -- discard left and abort
  1270.     jmp    .dhr3
  1271.  
  1272. ;ok -- mark up gpoint
  1273.     call    notemxg
  1274.  
  1275. ;now use left to find starting place in gbuf
  1276.     pop    d
  1277.     call    sublind
  1278. ;;    lxi    h,gbuf
  1279. ;;    pop    d
  1280. ;;    dad    d
  1281. ;get the requested pattern
  1282.     lda    val + 54*('R'-'@') + 2*('H'-'@')
  1283.     mov    e,a
  1284. ;get the mask
  1285.     lda    val + 54*('R'-'@') + 2*('H'-'@') + 1
  1286.     rar
  1287.     ani    07eh
  1288.     mov    d,a
  1289. ;now loop to store
  1290. ;  done?
  1291. .dhr2:
  1292.     mov    a,b
  1293.     ora    c
  1294.     jz    .dhr3
  1295.  
  1296.     mov    a,l
  1297.     ana    d
  1298.     jnz    $+4
  1299.  
  1300.     mov    m,e
  1301.     inx    h
  1302.     dcx    b
  1303.     jmp    .dhr2
  1304. .dhr3:
  1305. ;restore rulist pointer and rule count
  1306.     pop    h
  1307.     pop    b
  1308. ;go back and do next rule
  1309.     jmp    .dhr1
  1310.  
  1311.  
  1312. notemxg:
  1313.     lhld    maxgpt
  1314.     call    albu
  1315.     rc
  1316.     mov    h,d
  1317.     mov    l,e
  1318.     inx    h
  1319.     shld    maxgpt
  1320.     ret
  1321.  
  1322. ;do continuing verticals for interline, or just
  1323. ;skip down be leading, if none
  1324. ;assume required skips in HL
  1325. ;(called twice from above and also from cseq for \sk)
  1326. docvrule::
  1327.     mov    a,h
  1328.     ora    l
  1329.     rz
  1330. ;do at most 8 points at a time
  1331.     xchg
  1332.     lxi    h,PICA+1
  1333.     call    albu
  1334.     jc    .cv1
  1335.  
  1336.     call    cmh
  1337.     dad    d
  1338.     push    h
  1339.     lxi    d,PICA
  1340.     call    .cv1
  1341.     pop    h
  1342.     jmp    docvrule
  1343.  
  1344. .cv1:
  1345.     push    d
  1346.     mov    a,e
  1347.     call    dohrule
  1348.     lhld    maxgpt
  1349.     mov    a,h
  1350.     ora    l
  1351.     pop    d
  1352.     jz    .cvskip
  1353. ;so sendit sends enough
  1354.     shld    gpoint
  1355.     push    d
  1356.  
  1357.     push    d
  1358.     call    paperup##
  1359.     pop    d
  1360. ;if was page break, quit
  1361.     lhld    vposition
  1362.     xchg
  1363.     lhld    tm
  1364.     inx    h
  1365.     call    albu
  1366.     pop    d
  1367.     rc
  1368. ;(DE has orig. arg -- for now, assume <= 24 points)
  1369.     push    d
  1370. ;loop to print it
  1371.     mvi    d,3
  1372. .cvLoop:
  1373.     push    d
  1374.     call    sendit##
  1375.     pop    d
  1376.     dcr    d
  1377.     jnz    .cvLoop
  1378. ;now how far to skip to get below the rules?
  1379.     pop    d
  1380. ;we've gone down 3 dots already
  1381.     dcx    d
  1382.     dcx    d
  1383.     dcx    d
  1384. ;add rest to skips
  1385.  
  1386. .cvskip:
  1387.     lhld    skdots
  1388.     dad    d
  1389.     shld    skdots
  1390.     ret
  1391.  
  1392.  
  1393.  
  1394.     end
  1395.