CP/M/CPM_CDROM.iso/cpm/programs/list/ep-src.ark/STOWC.MAC

Text File | 1988-05-21 | 13.4 KB | 954 lines

    include    BDS.LIB
    include    EPDATA.MAC

    .comment    `

/************************************************/
/* Put char in outbuf, and record width & mode    */
/************************************************/

stowc(c)
char c;
{    int /* stowlen,*/ font;
    char hyflag;

    if (mode & IGNORE) return;

    /* check BS                */
    if (c == '\b')
    {    if (outpoint) bsflag = TRUE;
        return;
    }

    /* if several spaces between words, it's possible to
       get a SP at beginning of line during concatenation --
       but we don't want that        */
    if (!outpoint && c == ' ') return;

    /* store the character            */
    outbuf[outpoint] = c;

    /* check soft hyphen            */
    if (c == SOFTHY) {c = '-'; hyflag = TRUE; }
    else hyflag = FALSE;

    /* check flag character and required blank            */
    if (c >= 0x7F || c == rb) c = ' ';

    /* if graphic char or font undefined, look at earlier fonts    */
    font = (mode >> 8) & 7;
    while
    (    font
        && !(    (stowlen = ftlen[font-1][c])
              && ftname[font-1][0]
           )
    ) font--;

    stowmode = mode;
    stowkern = cs - val['K'-'@']['E'-'@'];


    /* flag "have one char in output line"    */
    if (font)
    {    grfflag = TRUE;

        stowmode = fix[font-1][0];
        if (stowmode & 0xFF00)
        {    if (stowmode < 0) stowkern -= stowmode >> 8;
            else    stowkern += stowmode >> 8;
            stowmode &= 0x00FF;
        }
        if (stowmode & PRPTNL)
        {    stowmode &= ~PRPTNL;
            stowmode |= TALL;
            duplflag = TRUE;
        }
        stowmode |= mode;

        if (stowmode & TALL) tallflag = TRUE;
    }
    else epsflag = TRUE;


    /* determine width            */
    if (bsflag)     stowlen = 0;
    else if (font) {if (cw) stowlen = cw;
            else if (stowlen + stowkern >  0)
                stowlen += stowkern;
            }
    else if (!(stowlen = modelen[mode & 63]))
            stowlen = pmlen[c];

    /* font number to b8-b10        */
    attrbuf[outpoint] =  (stowmode & 0xF8FF) | (font << 8);

    bsflag = FALSE;

    /* adjust for expanded, etc.        */
    if (stowmode & EXPNDD) stowlen <<= 1;
    if (font)
    {    if (stowmode & CMPRSSD) stowlen -= stowlen >> 2;
        if (stowmode & ELITE)   stowlen -= stowlen / 5;
        if (st)            stowlen += stowlen / st;
        if (sh)            stowlen -= stowlen / sh;
        if (stowmode & EMPHSZD && bo)
                    stowlen += bo << 1;
    }

    /* record width and inc't pointers    */
    widbuf[outpoint++] = stowlen;
    if (!hyflag) glen += stowlen;
}

            `

stowc::
    pop    d
    pop    h
    push    h
    push    d

;c argument kept in reg. C
; and (later) font kept in reg. B
    push    b
    mov    c,l

;back to here if repeat-char
.stc00:
;    if (mode & IGNORE) return;
    lda    mode+1
    ani    IGNORE shr 8
    jnz    .stcxt
;
;    /* check BS                */
;    if (c == '\b')
;    {    if (outpoint) bsflag = TRUE;
;        return;
;    }
    lhld    outpoint    ;for a bit later

    mov    a,c
;special characters C1-FF give automatic backspace
    cpi    0C1H
    jc    .stbs1
    ani    3FH
    mov    c,a
    sta    bsflag
.stbs1:    cpi    BCKFLAG        ;was 8
    jnz    .stc1
    mov    a,h
    ora    l
    jz    .stcxt
    mvi    a,1
    sta    bsflag
    jmp    .stcxt


;logic for punctuation factor
;(1) if SP ' " ) leave p_space as is
punctset:
    cpi    ' '
    rz
    cpi    27
    rz
    cpi    '"'
    rz
    cpi    ')'
    rz
;(2) if . ! ? set p_space = p.f.
    lda    pf
    sta    p_space
    mov    a,c
    cpi    '.'
    rz
    cpi    '!'
    rz
    cpi    '?'
    rz
;(3) otherwise reset
    xra    a
    sta    p_space
    ret
p_space:    db    0
;
;    /* if several spaces between words, it's possible to
;       get a SP at beginning of line during concatenation --
;       but we don't want that        */
;    if (!outpoint && c == ' ') return;
.stc1:
    call    punctset


;    lhld    outpoint
    mov    a,h
    ora    l
    jnz    .stc2

;(better do the following in newoutline -- here is not foolproof)
;reset punctuation space
    sta    p_space

;except if we're just putting to the terminal, go ahead
    lda    val + 54*('P'-'@') + 2*('T'-'@')
    ora    a
    jnz    .stc2
    mov    a,c
    cpi    ' '
    jz    .stcxt
;
;    /* store the character            */
;    outbuf[outpoint] = c;
.stc2:
;check for upper-case
    lda    val + 54*('U'-'@') + 2*('C'-'@')
    ora    a
    mov    a,c
    cnz    mapuc
    mov    c,a

    xchg
    lhld    outbuf
    xchg
;    lhld    outpoint
    dad    d
    mov    m,c

    dcx    h
    mov    a,m
    inx    h
    sta    laststow

;
;    /* check soft hyphen            */
;    if (c == SOFTHY) {c = '-'; hyflag = TRUE; }
;    else hyflag = FALSE;
    mov    a,c
    cpi    SOFTHY
    mvi    a,0
    jnz    .stc3
    mvi    c,'-'
    inr    a
.stc3:    sta    hyflag

;if it's a from-flag, make it a RA & remember outpoint
    mov    a,c
    cpi    FRFLAG
    jnz    .stc3a
    mvi    m,RAFLAG
    lhld    outpoint
    shld    frplace
.stc3a:
;
;    /* check flag character and required blank            */
;    if (c >= 0x7F || c == rb) c = ' ';

    mov    a,c
    inr    a
    jm    .stc4
    lda    rb
    cmp    c
    jnz    .stc5
.stc4:    mvi    c,' '
.stc5:

;Here put it to the console, if appropriate

    lda    val + 54*('P'-'@') + 2*('T'-'@')
    ora    a

    .comment    `
have to keep glen up for templates
    jz    .stc5a

    mov    a,c
    call    termput##
;if put-terminal, don't actually store it
    jmp    .stcxt
            `
    mov    a,c
    cnz    termput##

.stc5a:
;
;    /* if graphic char or font undefined, look at earlier fonts    */
;    font = (mode >> 8) & 7;

    lda    mode+1
    ani    7
    mov    b,a    ;henceforth B = font

;    while
;    (    font
;        && !(    (stowlen = ftlen[font-1][c])
;              && ftname[font-1][0]
;           )
;    ) font--;

.stc6:
    mov    a,b
    ora    a
    jz    .stc8

    mov    l,b
    dcr    l
    mvi    h,0
;HL = (font-1)*100H
;    lxi    d,128
;    call    usmul

    dad    h
    dad    h
    dad    h
    dad    h
    dad    h
    dad    h
    dad    h

    lxi    d,ftlen
    dad    d
    mov    e,c
    mvi    d,0
    dad    d
    mov    l,m
    mvi    h,0
    shld    stowlen

    mov    a,h
    ora    l
    jz    .stc7

    dcr    b
    call    getftn##
    inr    b

    mov    a,m
    ora    a
    jnz    .stc8
.stc7:
    dcr    b    ;font--
    jmp    .stc6
;end while
.stc8:

;
;    stowmode = mode;

    lhld    mode
    shld    stowmode

;    stowkern = cs - val['K'-'@']['E'-'@'];
    lhld    cs
    xchg
    lhld    ke
    call    cmh
    dad    d

;check for graphics font char
    lda    stowlen
    cpi    0ffh
    jnz    .stc8a
    lxi    h,450
    shld    stowlen
    lxi    h,0
.stc8a:
    shld    stowkern
;
;
;    /* flag "have one char in output line"    */
;    if (font)
    mov    a,b
    ora    a
    jz    .stc12
;    {    grfflag = TRUE;
    mvi    a,1
    sta    grfflag
;
;        stowmode = fix[font-1][0];
    mov    h,b
    dcr    h
    mvi    l,0    ;(font-1)*100h
    lxi    d,fix
    dad    d
    mov    a,m
    inx    h
    mov    h,m
    mov    l,a
    shld    stowmode
;        if (stowmode & 0xFF00)
;        {    if (stowmode < 0) stowkern -= stowmode >> 8;
;            else    stowkern += stowmode >> 8;
;            stowmode &= 0x00FF;
;        }
;    lhld    stowmode
    mov    a,h
    ora    a
    jz    .stc10

;DE = stowmode >> 8
    mov    e,h
    mvi    d,0

;    lhld    stowmode
;    mov    a,h
    ral
    jnc    .stc9
;here stowmode < 0
    call    cmd
.stc9:    lhld    stowkern
    dad    d
    shld    stowkern

    xra    a
    sta    stowmode+1

;        if (stowmode & PRPTNL)
;        {    stowmode &= ~PRPTNL;
;            stowmode |= TALL;
;            duplflag = TRUE;
;        }
.stc10:    lhld    stowmode
    mov    a,l
    ani    PRPTNL
    jz    .stc11

    mov    a,l
    ani    UNDRLN
    jz    .stc10.1
    mov    a,c
    cpi    ' '
    jc    .stc7
    cpi    60H
    jnc    .stc7

.stc10.1:
    mov    a,h
    ori    TALL shr 8
    mov    h,a
    mov    a,l
;;    ani    not (PRPTNL or UNDRLN)
    ani    not UNDRLN
    mov    l,a

    mvi    a,1
    sta    duplflag    ;?? was 'hycorrect'
;        stowmode |= mode;
.stc11:
    xchg
    lhld    mode
    mov    a,h
    ora    d
    mov    h,a
    mov    a,l
    ora    e
    mov    l,a
    shld    stowmode
;
;        if (stowmode & TALL) tallflag = TRUE;
;    lhld    stowmode
    mov    a,h
    ani    TALL shr 8
    jz    .stc11.1
    mvi    a,1
    sta    tallflag

;and ... if ' ' && p_space, add it in
.stc11.1:
    mov    a,c
    cpi    ' '
    jnz    .stc13
    lxi    h,p_space
    mov    a,m
    ora    a
    jz    .stc13
    mov    e,a
    xra    a
    mov    m,a
    mov    d,a
    lhld    stowlen
    push    h
    dad    h
    xchg
    call    usdiv
    pop    d
    dad    d
    shld    stowlen
;    }
    jmp    .stc13


;    else epsflag = TRUE;
.stc12:    mvi    a,1    ;(if not font)
    sta    epsflag
;
;
;    /* determine width            */
;    if (bsflag)     stowlen = 0;
;    else if (font) {if (cw) stowlen = cw;
;            else if (stowlen + stowkern >  0)
;                stowlen += stowkern;
;            }
;    else if (!(stowlen = modelen[mode & 63]))
;            stowlen = pmlen[c];
.stc13:    lda    bsflag
    ora    a

    mvi    l,0
    jnz    .stc17
;;    jz    .stc14
;;    lxi    h,0
;;    shld    stowlen
;;    jmp    .stc18

.stc14:
    mov    a,b
    ora    a
    jz    .stc16

    lhld    cw
    mov    a,h
    ora    l
;;    jz    .stc15
;;    lhld    cw
;;    shld    stowlen
;;    jmp    .stc18
    jnz    .stc17a

.stc15:    lhld    stowlen
    xchg
    lhld    stowkern
    dad    d

;(space-caps now separate)
;-    lda    val + 54*('U'-'@') + 2*('C'-'@')
;-    mov    e,a
;-    mvi    d,0
;-    dad    d

    dcx    h
    mov    a,h
    inx    h
    ora    a
    jm    .stc18
;;    shld    stowlen
;;    jmp    .stc18
    jmp    .stc17a



;(if not font)
.stc16:    lda    mode
    ani    63
    mov    e,a
    mvi    d,0

    lxi    h,modelen
    dad    d
    mov    l,m

    mov    a,l
    ora    a
    jnz    .stc17

    mov    l,c
    mvi    h,0
    lxi    d,pmlen
    dad    d
    mov    l,m
.stc17:    mvi    h,0
.stc17a:
    shld    stowlen
;
;    /* font number to b8-b10        */
;    attrbuf[outpoint] =  (stowmode & 0xF8FF) | (font << 8);
.stc18:    lhld    attrbuf
    xchg
    lhld    outpoint
    dad    h
    dad    d

    xchg
    lhld    stowmode
    mov    a,h
    ani    0f8h
    ora    b
    mov    h,a
    xchg

    mov    m,e
    inx    h
    mov    m,d

;no correction for native font
    mov    a,b
    ora    a
    jz    .stcNIT
;no correction for graphic font
    lda    stowlen+1
    ora    a
    jm    .stcNIT
;no correction if cw
    lda    cw
    ora    a
    jnz    .stcNIT

    call    .italcorr
    call    .kerncorr
    call    .capcorr
    jmp    .stcNIT

.capcorr:
    lda    val + 54*('S'-'@') + 2*('C'-'@')
    ora    a
    rz
    mov    l,a
    mov    a,c
    cpi    'A'
    rc
    cpi    'Z'+1
    rnc
    lda    laststow
    cpi    'A'
    rc
    cpi    'Z'+1
    rnc
    pop    d
    mvi    h,0
    jmp    .lastwch

.kerncorr:
;high byte of last attr left in E by italcorr
    mov    a,e
    ani    7
    cmp    b    ;not if fonts differ
    rnz

;font in B
    mov    a,b
    dcr    a
;(should also compare last font)
    mov    l,a
    mvi    h,0
    dad    h
    lxi    d,klist
    dad    d
    mov    e,m
    inx    h
    mov    d,m
    xchg
    mov    a,h
    ora    l
    rz

    mvi    e,0
    push    b
    lda    laststow
    mov    b,a
.kc1:    call    .ksearch
    ora    a
    jnz    .kc1
    pop    b
    mov    d,a
    mov    a,e
    ora    a
    rz
    pop    h    ;escape from call
    xchg
    dad    h    ;? 2 dots per mention
    call    cmh
    jmp    .lastwch

.ksearch:
    mov    a,m
    ora    a
    rz
    mov    d,a
    inx    h
    mov    a,m
    ora    a
    rz
    inx    h
    cmp    c
    rnz
    mov    a,b
    cmp    d
    rnz
    inr    e
    ret


.italcorr:
;italic correction for non-italic char preceded by italic
;(does not take account of bending, or expanded, or stretching)
    mov    a,e
    ani    ITALIC
    mov    e,a
    mov    a,d
    ani    BENT shr 8
    ora    e
;(wait)    rnz    ;no correction if this is italic

;step back in attrbuf to previous char
;(if outpoint = 0, invalid -- check later)
    dcx    h
    dcx    h
    mov    e,m    ;get last font for kerncorr
    rnz        ;NOW ret if this is italic or bent
    dcx    h
    mov    a,m
    ani    ITALIC
;if that was not italic, no correction
    jnz    $+7
    mov    a,e
    ani    BENT shr 8
    rz
    mov    d,e
    mov    e,m
;last mode in DE

;now do correction
;first, escape from caller so other corrections not done
    pop    h

;;    lxi    h,8
    xchg
    call    endcorr##
    xchg
.lastwch:
    shld    deltaL
    lxi    h,.stcNIT
    push    h

;now make sure not at beginning of output line
    lhld    outpoint
    mov    a,h
    ora    l
    rz

;here we have to correct
    dcx    h    ;point last
    dad    h    ;word array
    xchg
    lhld    widbuf
    dad    d

;a little patchwork -- if current is space, add width to it,
; instead of last, to prevent double corrections at end of line
    mov    a,c
    cpi    ' '
    jnz    $+6
    lxi    h,stowlen

;save array index
    push    h
;get previous width of last char in DE
    mov    e,m
    inx    h
    mov    d,m
;add the correction -- 1 dot per point, assuming 8 points high
;(change here for other correction: 'lhld deltal')
    lhld    deltaL
    dad    d
    xchg
;and enter it
    pop    h

;check for small width
    mov    a,d
    ora    a
    rm
    ora    e
    rz

    mov    m,e
    inx    h
    mov    m,d

;now adjust glen, unless adding to current SP
    mov    a,c
    cpi    ' '
    rz

    lhld    glen
;(change here for other correction: 'deltal equ $+1')
deltaL    equ    $+1
    lxi    d,8

    dad    d
    shld    glen
    ret




.stcNIT:
;
;    bsflag = FALSE;
    xra    a
    sta    bsflag
    mov    a,c
    sta    laststow
;
;    /* adjust for expanded, etc.        */
;    if (stowmode & EXPNDD) stowlen <<= 1;

    push    b

    lda    stowmode
    mov    c,a
;from here, keep low byte of stowmode in C
    lhld    stowlen
;... and stowlen in HL

    ani    EXPNDD
    jz    .stc19
;;    lhld    stowlen
    dad    h
    shld    stowlen
;    if (font)
.stc19:
    mov    a,b
    ora    a
    jz    .stc24
;    {    if (stowmode & CMPRSSD) stowlen -= stowlen >> 2;

    mov    a,c
    ani    CMPRSSD
    jz    .stc20

;;    lhld    stowlen
    push    h
;;    lhld    stowlen
    lxi    d,2
    call    shlrbe
    pop    d
    call    cmh
    dad    d
    shld    stowlen

;        if (stowmode & ELITE)   stowlen -= stowlen / 5;
.stc20:
    mov    a,c
    ani    ELITE
    jz    .stc21

;;    lhld    stowlen
    push    h
;;    lhld    stowlen
    lxi    d,5
    xchg
    call    sdiv
    pop    d
    call    cmh
    dad    d
    shld    stowlen

;        if (st)            stowlen += stowlen / st;
.stc21:
    lhld    st
    mov    a,h
    ora    l
    jz    .stc22

    xchg
    lhld    stowlen
    push    h
    xchg
    call    sdiv
    pop    d
    dad    d
    shld    stowlen

;        if (sh)            stowlen -= stowlen / sh;
.stc22:    lhld    sh
    mov    a,h
    ora    l
    jz    .stc23

    xchg
    lhld    stowlen
    push    h
    xchg
    call    sdiv
    pop    d
    call    cmh
    dad    d
    shld    stowlen
;        if (stowmode & EMPHSZD && bo)
;                    stowlen += bo << 1;
;    }
.stc23:
    lhld    bo
    mov    a,h
    ora    l
    jz    .stc24
    mov    a,c
    ani    EMPHSZD
    jz    .stc24

    lhld    stowlen
    xchg
    lhld    bo
    dad    h
    dad    d
    shld    stowlen
;
;    /* record width and inc't pointers    */
;    widbuf[outpoint++] = stowlen;
.stc24:
;get back char in c
    pop    b

    lhld    widbuf
    xchg
    lhld    outpoint
    inx    h

;is this right?
    lda    val + 54*('P'-'@') + 2*('T'-'@')
    ora    a
    jnz    $+6

    shld    outpoint
    dcx    h
    dad    h
    dad    d

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

;    if (!hyflag) glen += stowlen;
    lda    hyflag
    ora    a
    jnz    .stcxt

    lhld    glen
    dad    d
    shld    glen
;}
.stcxt:
    lxi    h,val + 54*('R'-'@') + 2*('C'-'@')
    mov    a,m
    ora    a
    jz    .stxxt
    dcr    m
    jnz    .stc00    ;go back and do it all again
.stxxt:
    pop    b
    ret

hyflag:        db    0
laststow:    db    0

stowlen:    dw    0
stowmode:    dw    0
stowkern:    dw    0


    end