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

Text File | 1988-05-21 | 6.4 KB | 503 lines

;functions GOTOCOL, HZSPACE, DOTAB

    include    BDSYM.EQU
    include    EPDATA


    .comment    `

/************************************************/
/************************************************/
gotocol(n)
int n;
{

            `


gotocol::
    pop    d
    pop    h
    push    h
    push    d

    push    b
;outpoint kept in BC
    shld    _gtc_n

;    /* back over any preceding spaces        */
;    while (outpoint && outbuf[outpoint-1] == ' ')


    lhld    outpoint
    mov    b,h
    mov    c,l
.gtc1:
    mov    h,b
    mov    l,c

    mov    a,h
    ora    l
    jz    .gtc2

    lhld    outbuf
    dad    b
    dcx    h
    mov    a,m

    cpi    ' '
    jz    .gtc1.1
    cpi    SPFLAG
    jnz    .gtc2

;    {    outpoint--;
.gtc1.1:
    dcx    b

;        glen -= widbuf[outpoint];
;    }
    lhld    widbuf
    dad    b
    dad    b
    mov    e,m
    inx    h
    mov    d,m
    call    cmd

    lhld    glen
    dad    d
    shld    glen
    jmp    .gtc1
;
;    /* and also, if no previous characters, reset lindent */
;    if (!outpoint /* && cc < 2 */) lindent[cc] = 0;
.gtc2:
    mov    a,b
    ora    c
    jnz    .gtc3

    lda    cc
    cpi    2
    jnc    .gtc3    ;??

;    lhld    cc
;    dad    h
;    lxi    d,lindent
;    dad    d
    call    getlindent##

    xra    a
    mov    m,a
;    inx    h
    dcx    h
    mov    m,a
;
;    /* store a SP flag with the appropriate width    */
;    outbuf[outpoint] = SPFLAG;

.gtc3:
;check frplace, and if had one, put it there
    lhld    frplace
    mov    a,h
    ora    a
    jm    .gtc3a
    mov    b,h
    mov    c,l
.gtc3a:
    lhld    outbuf
    dad    b
    mvi    m,SPFLAG

;    attrbuf[outpoint] = 0; /* was 'mode', but should stop ul */
    lhld    attrbuf
    dad    b
    dad    b

    xra    a
    mov    m,a
    inx    h
    mov    m,a
;
;    n -= lindent[cc];

;(don't subtract the indent at the beginning of a late col.
; in mc mode, because we're being called to do this indent, hopefully)


    call    getlindent##
    call    cmd

    lhld    _gtc_n
    lda    cc
    cpi    2
    jc    .gtc3s
    mov    a,b
    ora    c
    jz    $+4
.gtc3s:
    dad    d
    shld    _gtc_n

;    if (n > glen)
    xchg
    lhld    glen
    call    agbs
    jnc    .gtc4

;    {    widbuf[outpoint++] = n - glen;


    lhld    glen
    call    cmh
    xchg
    lhld    _gtc_n
    dad    d
    xchg

    lhld    widbuf
    dad    b
    dad    b
    inx    b

    lda    frplace+1
    ora    a
    jm    .gtc3b
;fix right end of rule 1
    push    h
    lhld    rulist+6
    mov    a,h
    ora    l
    jz    .gtcRUx
    lhld    rulist+4
    dad    d
    shld    rulist+6
.gtcRUx:
    pop    h

    push    h
    push    d
    mov    e,m
    inx    h
    mov    d,m
    pop    h
    dad    d
    xchg
    pop    h
.gtc3b:
    mov    m,e
    inx    h
    mov    m,d
;        glen = n;
;    }

    lhld    _gtc_n
    shld    glen

;
;    scrncol = ((glen+lindent[cc]) / PICA) +1;
;}
.gtc4:
;    lhld    cc
;    dad    h
;    lxi    d,lindent
;    dad    d
;    mov    e,m
;    inx    h
;    mov    d,m
    call    getlindent##

    lhld    glen
    dad    d

    lxi    d,pica
    xchg
    call    usdiv

    inx    h

    mov    a,l
    sta    scrncol

;if was put at frplace, don't advance, and unmark frplace
    lxi    h,frplace+1
    mov    a,m
    ora    a
    jm    .tspxt
    mvi    m,0ffh
    jmp    .tsp2
.tspxt:
    mov    h,b
    mov    l,c
    shld    outpoint
.tsp2:
    mvi    a,' '
    call    termput##

    pop    b
    ret

_gtc_n:    dw    0


    .comment    `

/************************************************/
/************************************************/
hzspace(n)
int n;
{

    /* store a SP flag with the appropriate width    */
    outbuf[outpoint] = HSFLAG;
    attrbuf[outpoint] = mode;
    widbuf[outpoint++] = n;
    glen += n;

}

            `

hzspace::
    pop    d
    pop    h
    push    h
    push    d

    push    h    ;n -- for later

    lhld    outbuf
    xchg
    lhld    outpoint
    inx    h
    shld    outpoint    ;outpoint++
    dcx    h
    push    h    ;for later
    dad    d
    mvi    m,HSFLAG


    lhld    attrbuf
    xchg

    pop    h    ;outpoint
    dad    h    ;word index
    push    h    ;for later
    dad    d

    xchg
    lhld    mode
    xchg
    mov    m,e
    inx    h
    mov    m,d

    lhld    widbuf

    pop    d    ;2*outpoint
    dad    d

    pop    d    ;n
    mov    m,e
    inx    h
    mov    m,d

    lhld    glen
    dad    d    ;still n
    shld    glen

    ret


    .comment    `

/************************************************/
/* Tab for embedded tab char in text        */
/************************************************/
dotab()
{    int dstcol;

    /* nominal char width is set when first tab is encountered */
    if (!val['T'-'@']['W'-'@'])
        if (mode & 0x700) val['T'-'@']['W'-'@'] = PICA;
        else val['T'-'@']['W'-'@'] = modelen[mode & 61];


    while (scrncol % 8) scrncol++;
    dstcol = scrncol * val['T'-'@']['W'-'@'] - lindent[cc];

    if (dstcol - glen <= 0) return;

    /* store a SP flag with the appropriate width, which is (we say),
       enough to line up next char with its screen position */
    outbuf[outpoint] = SPFLAG;
    attrbuf[outpoint] = mode;

    widbuf[outpoint++] = dstcol - glen;
    glen = dstcol;
}

            `


dotab::
    push    b

    lhld    outpoint
    mov    b,h
    mov    c,l

;    /* nominal char width is set when first tab is encountered */
;    if (!val['T'-'@']['W'-'@'])
    lhld    val + 54*('T'-'@') + 2*('W'-'@')    ;606c
    mov    a,h
    ora    l
    jnz    .dtb3
;        if (mode & 0x700) val['T'-'@']['W'-'@'] = PICA;
    lda    mode+1
    ani    7
    jz    .dtb1

    lxi    h,pica
    jmp    .dtb2
;        else val['T'-'@']['W'-'@'] = modelen[mode & 61];
.dtb1:    lda    mode
    ani    61
    mov    l,a
    mvi    h,0
    lxi    d,modelen
    dad    d
    mov    l,m
    mvi    h,0
.dtb2:    shld    val + 54*('T'-'@') + 2*('W'-'@')
;
;
;    while (scrncol % 8) scrncol++;
.dtb3:
    lxi    h,scrncol
.dtb4:
    mov    a,m
    ani    7
    jz    .dtb5

    inr    m
    jmp    .dtb4

;    dstcol = scrncol * val['T'-'@']['W'-'@'] - lindent[cc];
.dtb5:
;    lhld    scrncol
;    xchg
    mov    e,m

    lhld    cw
    mov    a,l
    ora    a
    jnz    $+6

    lhld    val + 54*('T'-'@') + 2*('W'-'@')
    mvi    d,0
    call    smul
    push    h

    call    getlindent##
    call    cmd

    pop    h
    dad    d

.dtb5.1:
    push    h
    call    inbch##
    cpi    ' '
    jnz    .dtb5.2
    call    nxspnt##
    lxi    d,PICA
    lda    val + 54*('C'-'@') + 2*('W'-'@')
    ora    a
    jz    $+4
    mov    e,a
    pop    h
    dad    d
    jmp    .dtb5.1
.dtb5.2:
    pop    h
    shld    dstcol
;
;    if (dstcol - glen <= 0) return;

    xchg
    lhld    glen
    call    cmh
    dad    d

    lxi    d,-1
    dad    d
    mov    a,h
    ral
;    jnc    .dtb6
    jc    .dtb7
;
;    /* store a SP flag with the appropriate width, which is (we say),
;       enough to line up next char with its screen position */
;    outbuf[outpoint] = SPFLAG;

.dtb6:    lhld    outbuf
    dad    b
    mvi    m,SPFLAG

;    attrbuf[outpoint] = mode;
;(should have been ... = 0)

;;    lhld    mode
;;    xchg

    lhld    attrbuf
    dad    b
    dad    b

;;    mov    m,e
;;    inx    h
;;    mov    m,d
    xra    a
    mov    m,a
    inx    h
    mov    m,a

;
;    widbuf[outpoint++] = dstcol - glen;

    lhld    dstcol
    xchg
    lhld    glen
    call    cmh
    dad    d
    xchg

    lhld    widbuf
    dad    b
    dad    b
    inx    b
    mov    m,e
    inx    h
    mov    m,d

;    glen = dstcol;

    lhld    dstcol
    shld    glen
;}

.dtb7:
    jmp    .tspxt

;-    mov    h,b
;-    mov    l,c
;-    shld    outpoint

;-    pop    b
;-    ret

dstcol:    dw    0

    end