Oakland CPM Archive/oakcpm.iso/cpm/list/ep-src.ark/PAPERUP.MAC

Text File | 1988-05-21 | 12KB | 854 lines

    include    BDSYM.EQU
    include    EPDATA

    .comment    `
functions PAPERUP, DOPAGENO



/************************************************/
/* Move print head to beginning of line and down*/
/*   accumulated 'skdots'             */
/************************************************/
paperup(needmore)
int needmore;
{    /* here page    */

    if (skdots < 0)
     if (mx) skdots = 0;
     else
     {
        if (vposition + skdots < 0) skdots = -vposition;
        vposition += skdots;
        while (skdots <= -216)
        {    PTESCCH('j'); PTCH(216);
            skdots += 216;
        }
        if (skdots < 0)
        {    PTESCCH('j'); PTCH(-skdots);
        }
        skdots = 0;
     }

    if (vposition + skdots + needmore + bm > pl)
    { if (!fm) skdots = pl - vposition  + tm;
      else
      {    skdots = pl - bm + fm - vposition;
        vposition = 0;
        dopageno();
        skdots += bm - vposition + tm;
      }
      vposition = tm;
    }
    else vposition += skdots;


    while (skdots >= 216)
    {    PTESCCH('J'); PTCH(216);
        skdots -= 216;
    }

    if (!skdots) return;

    PTESCCH('J'); PTCH(skdots);

    skdots = 0;
}            `

;call paperup before printing a line, to do accumulated skips and
; if necessary, footing and heading lines
paperup::

    pop    d
    pop    h
    push    h
    push    d

;if called while doing a title, don't trigger page break
    lda    nospec
    ora    a
    jnz    ejct

;if this will be the first line of a paragraph, add
; widow threshhold to needmore
    lda    val + 54*('P'-'@') + 2*('P'-'@')
    ora    a
    jz    .ppm1
    xchg
    lhld    val + 54*('W'-'@') + 2*('I'-'@')
    dad    d
.ppm1:
    push    h    ;save needmore

;if vposition is -1, this is the very first time we are being
; called, so initialize vposition, and do top of page business
    lhld    vposition
    inx    h
    mov    a,h
    ora    l
    jnz    .tti0

;init _savec
    lda    ec
    sta    _savec


    lhld    tm
    xchg
    lhld    hm
    call    cmh
    dad    d
    shld    vposition
    lhld    skdots
    push    h
    lxi    h,0
    shld    skdots
    call    ttitle
    pop    d
    lhld    skdots
    dad    d
    shld    skdots
.tti0:
    pop    h
    call    ejct

;call ttitle to check if time to print heading, and if so do it
ttitle:

;also, here is a good place to set noprint flag, if pn is out of range
;(well, it's a place, anyway)
    lhld    pn
    xchg
; before beginning page?
    lhld    bp
    mov    a,h
    ora    l
    jz    .pchk2
    call    albu
    mvi    a,0
    jc    .pchk3    ;(noprint)
; after ending page?
.pchk2:    lhld    ep
    mov    a,h
    ora    l
    jz    .pchk4
    call    blau    ;c if pn > ep
    mvi    a,0
    jnc    .pchk4    ;(yes print)
.pchk3: inr    a
.pchk4: sta    noprint


;see if time to print heading
    lda    hdgdone
    ora    a
    rnz

;otherwise, if heading is not requested, just skip down to tm
    lhld    hm
    mov    a,h
    ora    l
;if hm = 0, no heading
;... (this doesn't seem necessary -- would have done the 'rnc' above)
;-    jz    .tti1
;try just ret, instead:
    rz



;else do heading

;now print the heading

    lhld    val + 2*('H'-'@')
    call    dopageno
;and set the flag
    lxi    h,hdgdone
    inr    m

;here set skips to to tm
.tti1:
    lhld    vposition
    xchg
    lhld    skdots
    dad    d
    call    cmh

    xchg
    lhld    tm
    dad    d
;now HL is additional distance to skip to get down to tm

;don't skip up and print text over heading
    MOV    A,H
    ORA    A
    RM
    xchg
    lhld    skdots
    dad    d
    shld    skdots
;and go do them
    jmp    .pu9
;;    jmp    .pu10
;;??    ret

;call ejct to do a conditional page
;(called once at very end from epm)
ejct::

;save needmore
    shld    needmore


;    if (skdots < 0)
;     if (mx) skdots = 0;


    lhld    skdots
    mov    a,h
    ral
    jnc    .pu6

    lda    mx
    ora    a
    jz    .pu1

    lxi    h,0
    shld    skdots
    jmp    .pu6

;     else
;     {
;        if (vposition + skdots < 0) skdots = -vposition;
.pu1:
    lhld    vposition
    xchg
    lhld    skdots
    dad    d
    mov    a,h
    ral
    jnc    .pu2

    lhld    vposition
    call    cmh
    shld    skdots

;        vposition += skdots;

.pu2:
    lhld    vposition
    xchg
    lhld    skdots
    dad    d
    shld    vposition

;        while (skdots <= -216)
.pu3:
    lhld    skdots
    lxi    d,VINCH-1
    dad    d
    mov    a,h
    ral
    jnc    .pu4

;        {    PTESCCH('j'); PTCH(216);
;            skdots += 216;
;        }

    mvi    a,'j'
    call    presc1##
    mvi    a,VINCH
    call    pr1##

    lhld    skdots
    lxi    d,VINCH
    dad    d
    shld    skdots
    jmp    .pu3

;        if (skdots < 0)
.pu4:    lhld    skdots
    mov    a,h
    ral
    jnc    .pu5
;        {    PTESCCH('j'); PTCH(-skdots);
;        }
;        skdots = 0;
;     }

    mvi    a,'j'
    call    presc1##

    lhld    skdots
    call    cmh
    mov    a,l
    call    pr1##

.pu5:    lxi    h,0
    shld    skdots

;
;    if (vposition + skdots + needmore + bm > pl)
;see if time to do bottom of page action
.pu6:

;never print footing when doing heading or footing
    lda    nospec
    ora    a
    jnz    .pu9

    lhld    vposition

    xchg
    lhld    skdots
    dad    d

    xchg
    lhld    needmore
    dad    d

    xchg
    lhld    bm
    dad    d

    xchg
    lhld    pl
    call    agbs
    jnc    .pu9

;here it's time for a page break

;signal that we're going to want a heading on next page
    xra    a
    sta    hdgdone

;now see if we have to print a footing
;    { if (!fm) skdots = pl - vposition  + tm;

    lhld    fm
    mov    a,h
    ora    l
    jnz    .pu7

;no, no footing, so set skips to first line of next page
; (rest of this page and down to hm-tm on next)
    lhld    pl
    xchg
    lhld    vposition
    call    cmh
    dad    d

    xchg
    lhld    tm
    dad    d

    xchg
    lhld    hm
    call    cmh
    dad    d

    shld    skdots
;now go set vposition
    jmp    .pu8

;      else
;      {    skdots = pl - bm + fm - vposition;
;here we have to print a footing, so
; set skips down to that place
.pu7:
    lhld    pl
    xchg
    lhld    bm
    call    cmh
    dad    d

    xchg
    lhld    fm
    dad    d

    xchg
    lhld    vposition
    call    cmh
    dad    d

    shld    skdots

;        vposition = 0;
;        dopageno();
;        skdots += bm - vposition + tm;
;... and - hm
;      }
;now do the footing line

;arg is address of '$f', which if 0 will give def. centered page num.
    lhld    val + 2*('F'-'@')
    call    dopageno

;next page number
    lhld    pn
    inx    h
    shld    pn

;set to skip over rest of this page, and down to first line of next
    lhld    pl

    xchg
    lhld    vposition
    call    cmh
    dad    d
;check over past bm here?
    xchg
    lhld    tm
    dad    d

    xchg
    lhld    hm
    call    cmh
    dad    d

;(not this many ADDITIONAL dots  -- just this many)
;-    xchg
;-    lhld    skdots
;-    dad    d
    shld    skdots

;      vposition = tm;
;... - hm
;    }
;now set vposition to what it will be when we're done doing the
; skips that have accumulated in 'skdots'

.pu8:
;here we're going to be on first line of next page
    lhld    tm

    xchg
    lhld    hm
    call    cmh
    dad    d

    shld    vposition
    jmp    .pu10

;    else vposition += skdots;
;here we didn't hit a page break, so just add the skips in
.pu9:
    lhld    vposition
    xchg
    lhld    skdots
    dad    d
    shld    vposition


;
;
;    while (skdots >= 216)
;now do the downward skips, first by inches, then the remainder
.pu10:
    lhld    skdots

    push    h
.pu10.0:
    lxi    d,-PICA*2
    dad    d
    mov    a,h
    ora    a
    jm    .pu10.1
    push    h
    lxi    h,0
    mvi    a,newlin
    call    termput##
    pop    h
    jmp    .pu10.0
.pu10.1:
    pop    h

    lxi    d,-VINCH
    dad    d
    mov    a,h
    ral
    jc    .pu11

;    {    PTESCCH('J'); PTCH(216);
;        skdots -= 216;
;    }
    mvi    a,'J'
    call    presc1##
    mvi    a,VINCH
    call    pr1##

    lhld    skdots
    lxi    d,-VINCH
    dad    d
    shld    skdots
    jmp    .pu10

;
;    if (!skdots) return;
.pu11:
    lhld    skdots
    mov    a,h
    ora    l
    rz
;
;    PTESCCH('J'); PTCH(skdots);
.pu12:
    mvi    a,'J'
    call    presc1##
    lda    skdots
    call    pr1##

;
;    skdots = 0;
;}
    lxi    h,0
    shld    skdots
    ret

needmore:    dw    0

;flag to remember whether have put a heading on current page yet
hdgdone:    db    0    ;(initially: no)

    .comment    `
    int soutpoint, sglen, slindent, snc, scc, sllength, sdpmode;
    char sepsflag, sgrfflag, sduplflag, stallflag;
dopageno()
{
    outbuf += outpoint+20;
    attrbuf += outpoint+20;
    widbuf += outpoint+20;
    soutpoint = outpoint;
    slindent = lindent[cc];
    sglen    = glen;
    snc = nc; scc = cc;
    sllength = llength;
    sepsflag = epsflag;
    sgrfflag = grfflag;
    stallflag = tallflag;
    sduplflag = duplflag;

    glen = outpoint = lindent[0] = nc = cc = 0;
    epsflag = grfflag = tallflag = duplflag = FALSE;
    llength = ll - ir;

    sdpmode = mode; mode = 0x100;

    stowc(CEFLAG);
    inject(pn);
    gstr();

    outbuf = xoutbuf;
    attrbuf = xattrbuf;
    widbuf = xwidbuf;
    outpoint = soutpoint;
    nc = snc; cc = scc;
    lindent[cc] = slindent;
    glen = sglen;
    llength = sllength;
    epsflag = sepsflag;
    grfflag = sgrfflag;
    tallflag = stallflag;
    duplflag = sduplflag;
    mode = sdpmode;
    pn++;
}            `

dopageno::

;    outbuf += outpoint+20;
;    attrbuf += outpoint+20;
;    widbuf += outpoint+20;

;save address of heading string
    shld    _hdgstrng

;flag disable global print mode features
    lxi    h,nospec
    mov    a,m
    ora    a
    rnz
    mvi    m,1

    lhld    outpoint
    push    h
    xchg
    lhld    endovr
    call    albu
    jnc    $+4
    xchg        ;if outpoint < endovr, use latter

;    lxi    d,20
;    dad    d
;    xchg

    lhld    outbuf
    push    h
    dad    d
    shld    outbuf

    xchg
    dad    h
    xchg

    lhld    attrbuf
    push    h
    dad    d
    shld    attrbuf

    lhld    widbuf
    push    h
    dad    d
    shld    widbuf

;    soutpoint = outpoint;
;    slindent = lindent[cc]; (need only save indent[0])
;    sglen    = glen;

    lhld    lindent
    push    h

    lhld    glen
    push    h

;    snc = nc; scc = cc;
    lhld    nc
    push    h
    lhld    cc
    push    h

;    sllength = llength;
    lhld    llength
    push    h

;    sepsflag = epsflag;
;    sgrfflag = grfflag;
;    stallflag = tallflag;
;    sduplflag = duplflag;

    lda    brkflag
    push    psw
    lxi    h,bkaft
    mov    a,m
    mvi    m,0
    push    psw
    lda    epsflag
    push    psw
    lda    grfflag
    push    psw
    lda    tallflag
    push    psw
    lda    duplflag
    push    psw
;
;following added in case of internal break in head or foot

    lhld    co
    push    h
    lhld    ju
    push    h
    lhld    endovr
    push    h
    lhld    begovr
    push    h

;and still more
    lhld    bo
    push    h
    lhld    st
    push    h
    lhld    sh
    push    h
    lhld    cheight
    push    h
    lhld    cs
    push    h
    lhld    sl
    push    h
    lhld    ke
    push    h
    lhld    cw
    push    h
    lhld    be
    push    h
    lhld    align
    push    h
    lhld    uc
    push    h

;must have standard escape char
    lhld    ec
    push    h
    lda    _savec
    sta    ec

;
;    glen = outpoint = lindent[0] = nc = cc = 0;
    lxi    h,0
    shld    co
    shld    ju
    shld    cc
    shld    nc
;    shld    lindent
;    shld    outpoint
;    shld    glen

    shld    uc
    shld    align
    shld    be
    shld    cw
    shld    ke
    shld    sh
    shld    st
    shld    bo

    lxi    h,POINT
    shld    cs
    dad    h
    shld    sl
    lxi    h,PICA
    shld    cheight


;    epsflag = grfflag = tallflag = duplflag = FALSE;
;(done in newoutline)

;
;    sdpmode = mode; mode = 0x100;
    lhld    mode
    push    h

;default print mode is font 1 with all style mod's off
    lxi    h,0100H
    shld    mode

    call    newoutline##

;if '$footing' or '$heading' defined, use it
    lhld    _hdgstrng
    mov    a,h
    ora    l
    jz    .dpg1

    call    shfdirect##
    call    processline##
    call    shfdown##
    jmp    .dpg2
;
;    stowc(CEFLAG);

.dpg1:
;    call    newoutline##
    lxi    h,ceflag
    push    h
    call    stowc##
    pop    d

;    inject(pn);
    lhld    pn
    push    h
    call    inject##
    pop    d

;    gstr();
.dpg2:
    call    gstr##

;restoring now done off stack
;
;    outbuf = xoutbuf;
;    attrbuf = xattrbuf;
;    widbuf = xwidbuf;
;;etc.

    pop    h
    shld    mode

    pop    h
    shld    ec

    pop    h
    shld    uc
    pop    h
    shld    align
    pop    h
    shld    be
    pop    h
    shld    cw
    pop    h
    shld    ke
    pop    h
    shld    sl
    pop    h
    shld    cs
    pop    h
    shld    cheight
    pop    h
    shld    sh
    pop    h
    shld    st
    pop    h
    shld    bo

    pop    h
    shld    begovr
    pop    h
    shld    endovr
    pop    h
    shld    ju
    pop    h
    shld    co

    pop    psw
    sta    duplflag
    pop    psw
    sta    tallflag
    pop    psw
    sta    grfflag
    pop    psw
    sta    epsflag
    pop    psw
    sta    bkaft
    pop    psw
    sta    brkflag

    pop    h
    shld    llength
    pop    h
    shld    cc
    pop    h
    shld    nc
    pop    h
    shld    glen
    pop    h
    shld    lindent
    pop    h
    shld    widbuf
    pop    h
    shld    attrbuf
    pop    h
    shld    outbuf
    pop    h
    shld    outpoint

;    pn++;
;}
;now incr pn in ejct above
;    lhld    pn
;    inx    h
;    shld    pn


;flag re-enable global print mode features
    xra    a
    sta    nospec

    ret

_hdgstrng:    dw    0
_savec:        db    0

    end