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

Text File | 1988-05-21 | 26KB | 2,049 lines

    INCLUDE BDSYM.EQU
;    INCLUDE    EPSYM.EQU
    INCLUDE    EPDATA


;    FUNCTION    GCHR
    EXT        EPERROR,LOADFT




;/************************************************/
;/* Set the bits for 1/3 of one graphics char    */
;/************************************************/
;gchr(ix,pass)
;int ix, pass;
;{    int    len,    +00
;        i,    +02
;        j,    +04
;        cbase,    +06
;        gindex; +08
;    char    c,    +0AH
;        c0,    +0BH
;        c1,    +0CH
;        c2,    +0DH
;        charft,    +0EH
;        *ptft,    +0FH
;        ftn;    +11H
;(locals: 6 ints + 6 bytes = 18 bytes)
;        (bc)    +12H
;        (ret)    +14H
;        ix    +16H
;        pass    +18H
gchr::

    pop    d
    pop    h
    shld    ix
    mov    a,l
    ora    h
    jnz    gc0
    shld    lstlen
gc0:    pop    h
    mov    a,l
    sta    pass
    add    a
    add    a
    add    a
    sta    pix    ;for use by dotset
    push    h
    push    h
    push    d

    push    b

    LHLD    WIDBUF
    XCHG

    lhld    ix
    dad    h
    dad    d

    mov    a,m
    inx    h
    mov    h,m
    mov    l,a
    shld    widix    ;for later
;
;    /* get char out of buffer        */
;    c = outbuf[ix];
    LHLD    OUTBUF
    XCHG

    lhld    ix
    dad    d    ;= (outbuf) + (ix)
    mov    a,m
    sta    ch

;
;    /* skip soft hyphen & flag chars    */
;    if (c == SOFTHY || c >= 0x7F) return;

;(ch still in acc)
    cpi    SOFTHY    ;1EH
    jz    gchrret

    cpi    SPFLAG
    jnz    g1
    mvi    a,' '
    sta    ch
g1:    cpi    HSFLAG
    jz    g2
    cpi    7FH
    jnc    gchrret


g2:
    cpi    newlin
    jz    g2.1
    mov    e,a
    lda    tabottom
    ora    a
    jz    g2.1
    lda    pass
    dcr    a
    jnz    g2.1
    mov    a,e
    cpi    ' '
    jnz    g2.0
    lhld    widix
g2.sp:    push    h
    mvi    a,' '
    call    termput##
    pop    h
    lxi    d,-PICA
    dad    d
    mov    a,h
    ora    a
    jp    g2.sp
    jmp    g2.1
g2.0:    call    termput##
g2.1:
;
;    /* what font?                */
;    charft = 7 & (attrbuf[ix] >> 8);

    LHLD    ATTRBUF
    XCHG

    lhld    ix
    dad    h
;ix word
    dad    d
    mov    e,m
    inx    h
    mov    d,m
;attrbuf[ix]
;+    for later
    mov    b,d
    mov    c,e
;    shld    attrix
    mov    a,d
;    lxi    d,8
;    call    SHLRBE
;>> 8
;+
    ani    7
;& 7
    sta    charft
;charft =
;

;    /* if not in font, or native Epson font,
;       or required blank, make it a space    */
;    if (!charft || c < ' ' || c == rb) c = ' ';
;/*(change to allow c < SP) */

    ora    a
;$$    jz    i31f0
    jz    i322.sp
    dcr    a    ;for later
    sta    ftn
;!charft
    lda    ch
;new June '84
    cpi    HSFLAG
;$$    jz    i31f0
    jz    i322.sp

;    cpi    ' '
;    jc    i31f0
;c < ' '
    lhld    rb    ;rb
    cmp    l
    jz    i322.sp
;$$    jnz    i31f6
;== rb
;$$i31f0:
;$$    mvi    a,' '
;$$    sta    ch
; c = ' '

;
;    /* if 1st 3 of passes and not tall char, just space    */
;    if (!tabottom && !(attrbuf[ix] & TALL))  c = ' ';
;
i31f6:
;also if 1st big duplex pass & not duplex
    lda    tduplex
    cpi    2
    jnz    i31f6a
    mov    a,c
    ani    PRPTNL
    jz    i322.sp

i31f6a:
    lda    tabottom
    ora    a
    jnz    i3229

;!tabottom
;    lhld    attrix
    mov    a,b
    ani    40H
;    attrix & 4000H
;TALL
    jnz    i3229

;... and add: also sp if cheight > 16p

;if alignment requested, keep non-tall char
    LDA    ALIGN
    ORA    A
    JNZ    i3229


i322.sp:
    mvi    a,' '
    sta    ch
;c = ' '


;    /* if it's a space, just move pointer over    */
;    if (c == ' ')
;    {    gpoint += widbuf[ix];
;        return;
;    }

i3229:
;also treat all as space if noprint
    lda    noprint
    ora    a
    jnz    i3229a

    lda    ch
    cpi    ' '
    jnz    i3257
;c = ' ' ??
i3229a:
    lhld    gpoint
    xchg
    lhld    widix
    shld    lstlen
    dad    d
    shld    gpoint
    jmp    gchrret

i3257:

;
;    /* which font to use? number of graphics font is 0-7,
;        corresponding to 'fo' value of 1-8    */
;    ftn = charft - 1;

;    lda    charft
;    dcr    a
;done    sta    ftn

;    /* ... and where is the font?            */
;    if (!ftp[ftn]) /* reload if necessary */

    lda    ftn
    mov    l,a
    mvi    h,0
    dad    h
;ftn word
    lxi    d,ftp
    dad    d
    push    h
    mov    e,m
    inx    h
    mov    d,m

    pop    h
    xchg
    mov    a,h
;ftp[ftn]
    ora    l
    jnz    i329c

;     if (loadft(ftn) == ERROR) eperror(120+ftn);

    push    d    ;save addr. font location
    lda    ftn
    mov    l,a
    mvi    h,0
    push    h
    call    loadft
    pop    d
    inx    h
    mov    a,h
    ora    l
    pop    h
    jnz    i329c0
;== ERROR
    lda    ftn
    adi    120
    mov    l,a
    mvi    h,0
;+120
    push    h
    call    eperror    ;never returns
;;    pop    d


shftdup:
;check for duplex font
;(change here, since stowc will now leave mode prptnl for duplex)

;;    lda    ftn
;;    mov    h,a
;;    mvi    l,0
;;    lxi    d,fix
;;    dad    d
;;    mvi    a,PRPTNL
;;    ana    m
    mov    a,c
    ani    PRPTNL
    rz

;***
    lda    tduplex
    ora    a
    jz    .sdup3
;if tduplex=2, treat as though tabottom=0,
;if tduplex=1, treat as though tabottom=1.
    ani    1
    mov    l,a
    jmp    .sdup4


.sdup3:
;***

    mov    a,b        ;pretend not tall
    ani    not (TALL shr 8)    ;0BFH
    mov    b,a
    lhld    tabottom    ;L = tabottom, for later test
.sdup4:
    lda    ch
    mov    h,a
    cpi    5FH    ;should change to a sp if not tabottom
    rz
;if ch < 20H and top, shift up
    cpi    20H
    rz
    jnc    dup1
    mov    a,l
    ora    a
    rnz
dup4:    mov    a,h
    adi    20H
    jmp    dup
;if ch >= 60H and top, shift down
dup1:    cpi    60H
    jc    dup2
    mov    a,l
    ora    a
    rnz
dup3:    mov    a,h
    sui    20H
;;    jmp    dup
dup:    sta    ch
    ret
;if 21H <= ch <= 5F and top, no shift,
dup2:    mov    a,l
    ora    a
    rz
;otherwise when bottom, shift up if >= 40H, or shift down if less
    mov    a,h
    cpi    40H
    jc    dup3
    jmp    dup4





;    ptft = ftp[ftn];
;
i329c0:
    mov    e,m    ;reload ptr after
    inx    h    ;loadft call
    mov    d,m
    xchg

i329c:
;ftp[ftn]
    shld    ptft

    call    shftdup

ndup:


;ptft =

;    /* where to start laying in the black        */
;    gindex = gpoint;

    lhld    gpoint
    shld    gindex

;    /* update for next dots after these        */
;    gpoint += widbuf[ix];
;

;    lhld    gpoint
    xchg
    lhld    widix
    dad    d
;check not > 1920 = 780H
    mov    a,h
    cpi    GBUFSIZ shr 8    ;was 7
    jc    twok
    jnz    gchrret
    mov    a,l
    cpi    GBUFSIZ and 0FFH    ;was 80H
    jnc    gchrret
twok:    shld    gpoint

;    /* what width?                    */
;    len = ftlen[ftn][c];
;
;or:
    lda    ftn
    ora    a
    rar
    mov    h,a
    mvi    a,0
    rar
    mov    l,a

;-    lda    ftn
;-    mov    l,a
;-    mvi    h,0
;ftn
;-    lxi    d,80H
;-    call    USMUL
    lxi    d,ftlen
    dad    d
    xchg
    lda    ch
    mov    l,a
    mvi    h,0
;c
    dad    d
    mov    a,m
    sta    len
;len =

;    /* if width is 0, overprint            */
;    if (!widbuf[ix]) gindex -= widbuf[ix-1];

    lhld    widix
    mov    a,h
    ora    l
    jnz    i334d
;!widbuf[ix] ??
;gindex
    LHLD    WIDBUF
    XCHG

    lhld    ix
    dcx    h
;check not neg
    mov    a,h
    ora    a
    jm    i334d
;ix-1
    dad    h
    dad    d
    MOV    E,M
    INX    H
    MOV    D,M
    call    cmd
    lhld    gindex
    dad    d
    push    h

    lhld    lstlen
    xchg
    lhld    len
    mvi    h,0
    call    cmh
    dad    d
    lxi    d,2
    xchg
    call    sdiv
    xchg
    pop    h
    dad    d
    shld    gindex
;gpoint =
    jmp    i33b2

;    /* if non-proportional, center in char field    */
;    else if (cw) gindex += (j = (widbuf[ix] - len) / 2) > 0 ? j : 0;
;        /* bad way to test - can be sync problem */
;
;

i334d:
;store st and sw in temporary locations
    lhld    st
    shld    _st
    lhld    sh
    shld    _sh

;no fixed cw if graphic
    lda    len
    inr    a
    jz    i33b2

    lhld    cw
    mov    a,h
    ora    l
    jz    i33b2
;here fixed cw request

;desired new ink width is recorded width - character-spacing
;(here we neglect shrink or stretch of cs itself)

    lhld    widix
    xchg
    lhld    cs
    call    cmh
    dad    d
;check for cs > cw
    mov    a,h
    ora    a
    jm    i33b2

;;Tried calling wadjust -- Worse than before
;;;new -- if high is > 1, use max stretch
;;;(try to prevent overflow in rest of calc.)
;;    dcr    a
;;    dcr    a
;;    jm    .gcw1
;;    mvi    a,200
;;    jmp    .gcw5
;;.gcw1:

;;;new vers -- ready to take percent change
;;    lxi    d,100
;;    call    usmul

;old ink width is in len -- take difference
    lda    len
    mov    e,a
    mvi    d,0
;;;new - round and get percent change
;;    dcx    d
;;    dad    d
;;    inx    d
;;    xchg
;;    call    usdiv
;;;now wadjust calculates desired st and sh
;;    mov    a,l
;;.gcw5:
;;    call    wadjust##
;;    shld    _st
;;    xchg
;;    shld    _sh

    push    d    ;save len for a moment

    call    cmd
    dad    d

;if positive, we want to stretch
    mov    a,h
    ora    a
    pop    d    ;get len back
;remember sign
    push    psw
    jm    .gcw6
;if positive and diff. > len, max stretch will be insufficient,
; and we should center it (if diff = len, center vacuously)
    call     albu
    jnc    .gcw7
    call    cmd
    dad    d
;HL = diff - len, which is amount that cannot be done by stretching
    mvi    e,1
    call    shlrbe
    xchg
    lhld    gindex
    dad    d
    shld    gindex
;now it's centered -- go stretch by maximum
    lxi    h,1
    jmp    .gcw8

.gcw6:
;get absolute value
    call    cmh
.gcw7:
;st or sh = old-ink / |new-ink - old-ink|
    push    h
    xchg
    lhld    widix
;round up
    dcx    d
    dad    d
    xchg
    pop    h
    call    usdiv
.gcw8:
;other value will be 0
    lxi    d,0
    pop    psw
    jp    $+4
    xchg

;(if stretching, shouldn't allow stretch 0 -- can we get that here?)

    shld    _st
    xchg
;don't allow shrink 1
    mov    a,l
    dcr    a
    jnz    $+4
    inx    h
    shld    _sh




    .comment    `
Real old code for cw ...
(it would still be nice to do a little centering) <-- now done
    lhld    widix
    xchg
    lda    len
    mov    l,a
    mvi    h,0
;len
    call    CMH
    dad    d
;widbuf[ix] - len
    mov    a,h
    ora    a
    jm    i33b2
    rar
    mov    h,a
    mov    a,l
    rar
    mov    l,a

    xchg
    lhld    gindex
    dad    d
    shld    gindex
        `

i33b2:
    lda    len
    sta    lstlen

;    /* where do the bits start in the font?        */
;    cbase = fix[ftn][c] + pass*len;
;
    lda    ftn

    mov    h,a
    mvi    l,0
    lxi    d,fix
    dad    d

    xchg
    lda    ch
    mov    l,a
    mvi    h,0
    dad    h
    dad    d

    mov    e,m
    inx    h
    mov    d,m
;fix[ftn][c]
    lhld    ptft
    dad    d
    shld    ptft0

    lda    len
;graph char only 1 pass
    cpi    0ffh
    jnz    $+4
    xra    a
    mov    e,a
    mvi    d,0
    dad    d
    shld    ptft1
    dad    d

;exchange 1st and 3rd pass data if bent and upside down or gothic
    mov    a,b
    ani    BENT shr 8
    jz    i33b.nb
    lda    be+1
    ani    30H
    jz    i33b.nb
    xchg
    lhld    ptft0
    xchg
    shld    ptft0
    xchg
i33b.nb:
    shld    ptft2

;and another little change for graph char
    xra    a
    sta    len+1
    lxi    h,450
    lda    len
    cpi    0ffh
    jnz    $+6
    shld    len

;    /* move the dots into the output graphics buffer    */
;    for (i = cbase; i < cbase + len; i++)

;**-> for ( ; len; len--)
;i < cbase + len ff.
i3400:
    lhld    len
    mov    a,h
    ora    l
    jz    gchrret
    dcx    h
    shld    len

;    {    c = ptft[i];
;
;**-> c = ptft0 if pass 0, = ptft1 if pass 1, = ptft2 if pass 2

    lhld    ptft0
    mov    a,m
    sta    c0
    sta    ch
    lhld    ptft1
    mov    a,m
    sta    c1
    lhld    ptft2
    mov    a,m
    sta    c2

;For tall and cheight > 8 points but not 16-<24p,
;  stretch up as per char. height
    mov    a,b
    ani    40H
    jz    i33nt
    lda    cheight
    cpi    3*8+1
    jc    i33nt
    cpi    3*16
    jc    i33ts
    cpi    3*24
    jc    i33nt
i33ts:    push    b
    call    canon
    call    hidots
    call    decanon
    pop    b
    lda    c0
    sta    ch
i33nt:
    lda    pass
    ora    a
    jz    i3400c
    dcr    a
    jz    i3400a
    lda    c2
    jmp    i3400b
i3400a:    lda    c1
i3400b:    sta    ch
i3400c:

;c =
;        /* modify vertical format of char        */
;        if
;        (    fa
;            || attrbuf[ix]
;               & (    SUPSCRPT | SUBSCRPT | DBLSTRK | TALL)
;        )
;
;(should fix tall super- and subscripts)
    lda    fa    ;fa
    ora    a
    jnz    i3468
;fa ??
;    lhld    attrix
;    lxi    d,5810H    ;0101100000010000

    mov    a,b
    ani    58H
    mov    h,a
    mov    a,c
    ani    10H
    ora    h
    jz    i37cb

;        {    j = i - pass*len;
i3468:
;*-> nothing, work done already
;done            c0 = ptft[j];
;done            c1 = ptft[j + len];
;done            c2 = ptft[j + len + len];
;            if (attrbuf[ix] & DBLSTRK)

;    lhld    attrix
;    lda    attrix
    mov    a,c
    ani    10H
    jz    i35be
;disable double striking for tall char?
;    MOV    A,B
;    ANI    40H
;    JNZ    i35be
;            {    c = c1;
    lxi    h,c1
    mov    a,m
    sta    ch
;                c1 |= c0;
;    lxi    h,c1
    lda    c0
    ora    m
    mov    m,a

;                c0 |= c2 >> 1;
    lxi    h,c0
    lda    c2
    ora    a
    rar
    ora    m
    mov    m,a

;                c2 |= c;
    lxi    h,c2
    lda    ch
    ora    m
    mov    m,a

;                if (!pass) c = c0;
    lda    pass
    ora    a
    jnz    i3597

    lda    c0
;    sta    ch

    jmp    i35b3x


;                else if (pass == 1) c = c1; else c = c2;
;            }
i3597:
    dcr    a
    ora    a
    jnz    i35b3
;pass == 1 ??
    lda    c1
;    sta    ch
;c = c1
    jmp    i35b3x

i35b3:
    lda    c2
i35b3x:    sta    ch
;c = c2

;            if (attrbuf[ix] & (SUPSCRPT | SUBSCRPT))

i35be:

;    lda    attrix+1
    mov    a,b
    ani    18H
;    lxi    d,1800H...
    jz    i3743
;if TALL superscript, no shrinking ...
    mov    a,b
    ani    40H
    jz    i35ss
    mov    a,b
    ani    10H
    jz    i35ss
    lda    tabottom
    ora    a
    jz    i37cb
    xra    a
    sta    ch
    jmp    i37cb

i35ss:
;            {    if (!pass) c2 = 0;

    lda    pass
    ora    a
    jnz    i35f9
    sta    c2
    jmp    i3649
;                else if (pass == 1)
;                    {c1 = 0; c0 <<= 1;}
i35f9:
;    lda    pass
    dcr    a
    jnz    i361c
;pass == 1 ??
    sta    c1
;c1 = 0
    lda    c0
    add    a
    sta    c0
;c0 <<= 1
    jmp    i3649
;                else if (pass == 2)
;                -> else
i361c:
;    dcr    a
;    jnz    i3649
;                    {c0 = 0; c1 <<= 1; c2 <<= 1;}
    xra    a
    sta    c0
;c0 = 0
    lda    c1
    add    a
    sta    c1
;c1 <<= 1
    lda    c2
    add    a
    sta    c2
;c2 <<= 1
;                c = c0 | c1 | c2;
i3649:
    lda    c0
    lxi    h,c1
    ora    m
    lxi    h,c2
    ora    m
;    sta    ch
;                c = (c & 128) |
    mov    h,a
    ani    80H
    mov    l,a
;                    ((c << 1) & 64) |
    mov    a,h
    add    a
    mov    h,a
    ani    40H
    ora    l
    mov    l,a
;                    ((c << 2) & 32) |
    mov    a,h
    add    a
    mov    h,a
    ani    20H
    ora    l
    mov    l,a
;                    ((c << 3) & 16);
    mov    a,h
    add    a
    ani    10H
    ora    l

    sta    ch
;c =
;                if (attrbuf[ix] & SUBSCRPT) c >>= 2;
;    lda    attrix+1
    mov    a,b
    ani    10H    ;attrix & 1000H
    jz    i370d

    lda    ch
    rar
    rar
    ani    3FH
    sta    ch
;                if (!(attrbuf[ix] & SUPSCRPT)) c >>= 2;
;            }
i370d:
;    lda    attrix+1
    mov    a,b
    ani    8    ;attrix & 0800H
    jnz    i3743

    lda    ch
    rar
    rar
    ani    3FH
    sta    ch
;            if (attrbuf[ix] & TALL)
i3743:
;    lda    attrix+1
    mov    a,b
    ani    40H    ;attrix & 4000H
    jz    i3799
;double height for 0..8points or 16..<24 points
    lda    cheight
    cpi    3*24
    jnc    i3799
    cpi    3*8+1
    jc    i37tt
    cpi    3*16
    jc    i3799
i37tt:
;             c = maketall(pass,c0,c1,c2);
;maketall references now global
    call    maketall
    jmp    i37cb

;            else if (fa) c = c0 | c1 | c2;
;        }
i3799:
    lhld    fa    ;fa
    mov    a,h
    ora    l
    jz    i37cb

    lda    c0
    lxi    h,c1
    ora    m
    lxi    h,c2
    ora    m
    sta    ch

;
;        dotset(attrbuf[ix], gindex++, pass << 3, c);
i37cb:
;2nd parm now passed in HL, others global
    lhld    gindex

;if no dots, skip down to gindex adjustments
    LDA    CH
    ORA    A
    JNZ    i37tg
    INX    H
    SHLD    GINDEX
    JMP    i38c4

i37tg:
;align non-tall characters in tall lines
    mov    a,b
    ani    40H
    jnz    i37dt    ;not if tall
    mov    a,c
    ani    PRPTNL
    jnz    i37dt    ;not if duplex

    lda    tallflag
    ora    a
    jz    i37dt    ;not if line not tall
    lda    align
    ora    a
    jz    i37dt    ;not if no alignment request
    mov    e,a
    lhld    ch
    mvi    h,0
    call    shllbe
    lda    tabottom
    ora    a
    jnz    alg1
    mov    l,h
alg1:    mov    a,l
    sta    ch
    lhld    gindex
i37dt:
    push    h
    call    dotset
    pop    h
    inx    h
    shld    gindex
;
;        if (attrbuf[ix] & EMPHSZD)

;    lda    attrix
    mov    a,c
    ani    8
    jz    i38c4
;        {    j = (bo << 1) -1;
;            if (j < 0) j = 1;
    LDA    BO
    ora    a
    JNZ    I3853
    INR    A

;            for ( ; j > 0; j--,j--)
i3853:
    MVI    L,1
    MOV    H,A
i385l:
    PUSH    H
    MVI    H,0


    .comment    `
May as well give up on this.
    lda    callig
    ora    a
    jz    i385m

    push    h
;index + 1 pass for each level of emphasis
    lda    pass
    mov    e,a
    mvi    d,0
    dad    d
    push    h
    xchg
    lxi    h,3
    call    usmod
    xchg
    lxi    h,c0
    dad    d
    mov    l,m
    mvi    h,0
;shift left 1 every 3rd level of emphasis
    pop    d
    push    h
    lxi    h,3
    call    usdiv
    xchg
    pop    h
    call    shllbe
    mov    a,l

    sta    ch
    pop    h
;;    JMP    I385N
    jmp    $+4
            `



i385m:    DAD    H
    DCX    H
i385n:
;            dotset(attrbuf[ix], gindex + j, pass << 3, c);
;        }
    xchg
    lhld    gindex
    dad    d

    call    dotset
;((... j--,j--

    POP    H
    INR    L
    DCR    H
    JNZ    I385L


;        if (attrbuf[ix] & EXPNDD) gindex++;
i38c4:
    lhld    gindex
    push    h

;    lda    attrix
    mov    a,c
    ani    20H    ;& 0020H
    jz    i38f4
    pop    h
    inx    h
    push    h
;        if (attrbuf[ix] & CMPRSSD && i % 4 == 1) gindex--;
i38f4:

;    lda    attrix
    mov    a,c
    ani    4
    jz    i3939

    lda    ptft0    ;no longer use i
    ani    3
    dcr    a
    jnz    i3939

    pop    h
    dcx    h
    push    h

;        if (attrbuf[ix] & ELITE   && i % 5 == 3) gindex--;
i3939:
;    lda    attrix
    mov    a,c
    ani    1
    jz    i3980
    lhld    ptft0
    lxi    d,5
    xchg
    call    USMOD
    dcx    h
    dcx    h
    dcx    h
    mov    a,h
    ora    l
    jnz    i3980

    pop    h
    dcx    h
    push    h
;        if (sh && !(i % sh)) gindex--;
i3980:
    lhld    _sh
    mov    a,h
    ora    l
    jz    i39a8
    xchg
    lhld    ptft0
    xchg
    call    USMOD
    mov    a,h
    ora    l
    jnz    i39a8

    pop    h
    dcx    h
    push    h
;        if (st && !(i % st)) gindex++;
i39a8:
    lhld    _st
    mov    a,h
    ora    l
    jz    i39d0

    xchg
    lhld    ptft0
    xchg
    call    USMOD
    mov    a,h
    ora    l
    jnz    i39d0

    pop    h
    inx    h
    push    h
;    }
;}
;

i39d0:
    pop    h
    shld    gindex

    lhld    ptft0
    inx    h
    shld    ptft0
    lhld    ptft1
    inx    h
    shld    ptft1
    lhld    ptft2
    inx    h
    shld    ptft2

    jmp    i3400

gchrret:
    pop    b
    ret


;
;dotset(kind, gindex, pix, c)
;int        kind,    +08 === attrbuf[ix]
;        gindex,    +0A === gindex or gindex + j
;        pix;    +0C === pass << 3
;char        c;    +0E === c
;{    int    bx,    +00
;        power;    +02
;

dotset:
    shld    dtgindex

;    if (kind & BENT)
    mov    a,b
;    lda    attrix+1
    ani    20H    ;& 2000H
    jz    i3b17
;;    LDA    BE
;;    ORA    A
;;    JZ    I3B17

;Now mode is bent and bend > 0
;    for (bx = 0, power = 1; bx < 8; bx++, power <<= 1)

    xra    a
    sta    bx
    inr    a
    sta    power
;bx = 0
;power = 1


;start of loop for bent chars

i3a14:
;(test now at end)
;    {    if (kind & ITALIC)
;        gbuf[gindex + bx + bending[be-1][pix + bx]] |= power & c;

    lhld    dtgindex

    .comment    `
;here A = power
    mov    e,a
    lda    be+1
    ani    80h
    jz    i3a14.1
    push    h
    mov    a,e
    lxi    d,gbuf-1
    dad    d
    ana    m
    pop    h
    jz    i3af9
if really want to do this, just jmp so not bent next time
i3a14.1:
            `

;(if italic add bx)
    mov    a,c
    ani    80H
    jz    i3a14a
    lda    bx
    mov    e,a

;top of italicized tall or duplex character over by 8
    mov    a,c
    ani    PRPTNL
    jnz    $+9

    MOV    A,B
    ANI    40H
    JZ    i3nt1
    LDA    TABOTTOM
    ORA    A
    JNZ    i3nt1
    MOV    A,E
    ADI    8
    MOV    E,A
i3nt1:
    mvi    d,0
    dad    d
i3a14a:
    push    h



;;    lhld    be    ;be
    lda    be+1
    ani    7
    mov    h,a
    dcr    a
    jm    .bnt1
    mov    l,a
    add    a    ;*2
    add    l    ;*3
    mov    l,a
    mvi    h,0
    dad    h    ;*6
    dad    h    ;*12
    dad    h    ;*24

;;    dcx    h
;be - 1
;;    lxi    d,24
;;    call    USMUL

    lxi    d,bending
    dad    d
.bnt1:
    xchg

    lda    pix
    mov    l,a
    lda    bx

;for tall, index every other
    MOV    H,A
    MOV    A,B
    ANI    40H
    JZ    i3nt2
    MOV    A,H
    RAR
    MOV    H,A
    LDA    TABOTTOM
    ORA    A
    JNZ    i3nt2
    MOV    A,H
    ADI    4
    MOV    H,A
i3nt2:
    MOV    A,H
    push    psw

    add    l
    mov    l,a
;L = row (0-23) to index
    mvi    h,0

;high of DE is 0 if no table value sought
    mov    a,d
    ora    a
    jz    .bnt2
;DE is still bending[...]
    dad    d

    mov    d,m
.bnt2:
    mov    l,d
;L = right displacement for this row of dots
    mvi    h,0

    lda    pass
    mov    d,a
;get back adjusted bx
    pop    psw    ;is 0..7
    inr    a    ;is 1..8
    mov    e,a
    add    a
    add    e    ;*3 -- is 3..24

    dcr    a    ;is 2..23
    sub    d    ;is 0..23

    add    a    ;is 0..46
    mov    e,a
    mov    d,h


;any slant?
    lda    be
    push    psw
;add in foreslant or backslant according to row in E

;low nib is foreslant
    call    ..slant
;invert row for backslant in high nib
    mvi    a,46
    sub    e
    mov    e,a

    pop    psw
    rar
    rar
    rar
    rar
    call    ..slant

;bending[be-1][pix + bx]

    pop    d    ;dtgindex + bx
    dad    d

    lxi    d,gbuf
    dad    d
    push    h
    mov    e,m

;;    lda    power
;;    mov    l,a
;;    lda    ch
    call    updwnch
    lda    power

    ana    l
        ;gbuf[...]
    ora    e

    pop    h    ;@gbuf[...]
    mov    m,a
;    jmp    i3af9
;        else gbuf[gindex + bending[be-1][pix + bx]] |= power & c;
;    }

;("else" included in preceding loop now)
;
;((    for (...;...; bx++, power <<= 1)
;
i3af9:
    lda    bx
    inr    a
    sta    bx

    lda    power
    add    a
    sta    power

    rc
    jmp    i3a14
;
;i3b14:    jmp    dsetret


;add to displ. in HL slant in Acc according to row # in DE
..slant:
    ani    0fh
    rz
    push    d
    push    h
    cma
    ani    0fh
    jz    ..slax
    inr    a
    mov    l,a
    mvi    h,0
    call    usdiv
    pop    d
    dad    d
    pop    d
    ret
..slax:    pop    h
    dad    d
    pop    d
    ret


updwnch:
    lda    be+1
    ani    20h
    lda    ch
    mov    l,a
    rz
    mvi    d,8
.upd1:    mov    a,l
    rar
    mov    l,a
    mov    a,h
    ral
    mov    h,a
    dcr    d
    jnz    .upd1
    mov    l,h
    ret




;    else if (kind & ITALIC)
i3b17:
;    lda    attrix
    mov    a,c
    ani    80H
    jz    i3ba0
;    for (bx = 0, power = 1; bx < 8; bx++, power <<= 1)

;;    push    b
;;    mvi    c,1
    lhld    dtgindex
    lxi    d,gbuf
;over 8 more for top of tall or duplex character
    mov    a,c
    ani    PRPTNL
    push    b
    mvi    c,1
    jnz    $+9
    MOV    A,B
    ANI    40H
    JZ    i3nt3
    LDA    TABOTTOM
    ORA    A
    JNZ    i3nt3
    LXI    D,GBUF+8
i3nt3:

    dad    d
    lda    ch
    mov    d,a
;bx = 0
;power = 1
i3b3c:
;        gbuf[gindex++] |= power & c;
    mov    e,m
    mov    a,d
    ana    c
    ora    e
    mov    m,a
    inx    h
    mov    a,c
    add    a
    mov    c,a

    jnc    i3b3c
;    jmp    i3b3c

i3b9d:    pop    b
;    jmp    dsetret
    ret
;    else gbuf[gindex] |= c;

i3ba0:
    lhld    dtgindex
    lxi    d,gbuf
    dad    d
    mov    e,m
    lda    ch
    ora    e
    mov    m,a

;}
;

;dsetret:
;    pop    b
    ret


;
;maketall(pass,c0,c1,c2)
;char        pass,    05
;        c0,    07
;        c1,    09
;        c2;    0B
;{    char    c;    00    (returned)
maketall:
    push    b
;
;    if (tabottom)
    lhld    tabottom
    mov    a,l
    ora    a
    jz    i3c07
;    {    c0 <<= 4;
    lda    c0
    add    a
    add    a
    add    a
    add    a
    sta    c0
;        c1 <<= 4;
    lda    c1
    add    a
    add    a
    add    a
    add    a
    sta    c1
;        c2 <<= 4;
;    }
    lda    c2
    add    a
    add    a
    add    a
    add    a
    sta    c2
;
;    switch (pass)

i3c07:
    lda    pass

;    cpi    0
;    jz    i3c1f
    cpi    1
    jz    i3c4c
    cpi    2
    jz    i3c79
;    jmp    i3ca6
;    {    case 0:    c = tallfu(c0) | tallfu(c1) >> 1; break;
;i3c1f:
    lda    c0
    call    tallfu
    push    psw
    lda    c1
    jmp    i3c79b

;    jmp    i3ca6
;        case 1:    c = tallfu(c0) | tallfu(c2) >> 1; break;
i3c4c:
    lda    c0
    jmp    i3c79a

;    jmp    i3ca6
;        case 2:    c = tallfu(c1) | tallfu(c2) >> 1; break;
i3c79:
    lda    c1
i3c79a:    call    tallfu
    push    psw
    lda    c2
i3c79b:    call    tallfu
    ora    a
    rar
    mov    l,a
    pop    psw
    ora    l

;    }
;
;    return(c);
;}
i3ca6:
    sta    ch
    pop    b
    ret


;
;tallfu(c)
;char c;
;{

tallfu:
    push    b
    mov    b,a
;    return
;    (       c       & 128
    ani    80H
    mov    c,a
;        | (c >> 1) &  32
    mov    a,b
    rar
    ani    20H
    ora    c
    mov    c,a
;        | (c >> 2) &   8
    mov    a,b
    rar
    rar
    ani    8
    ora    c
    mov    c,a
;        | (c >> 3) &   2
    mov    a,b
    rar
    rar
    rar
    ani    2
    ora    c

;    );
;}
;
    pop    b
    ret

;$pass:    db    0
;$ch:    db    0
;$c0:    db    0
;$c1:    db    0
;$c2:    db    0
;$bx:    db    0
;$ftn:    db    0
;$charft:    db    0
;$len:    dw    0
;$lstlen:    dw    0
;$pix:    db    0

;$power:    db    0
;$gindex:    dw    0
;$dtgindex:    dw    0
;$ix:        dw    0
;(kept in BC)
;attrix:    dw    0
;$widix:    dw    0
;$ptft:    dw    0
;$ptft0:    dw    0
;$ptft1:    dw    0
;$ptft2:    dw    0
;$gcj:    dw    0

;$cx48:    db    0,0,0,0,0,0

;$_st:    dw    0
;$_sh:    dw    0

;For a tall=1 character:
; canon, hidots, decanon
;(Ref. to cheight required)


;canonicalize C0,C1,C2 with result in CX48
canon:
    lxi    h,0
    shld    cx48
    shld    cx48+2
    lda    c0
    mov    h,a
    lda    c1
    mov    l,a
    lda    c2
    mov    e,a
    mvi    b,8
    call    shft
    sta    cx48+3
    mvi    b,8
    call    shft2
    sta    cx48+4
    mvi    b,8
    call    shft3
    sta    cx48+5
    ret

;decanonicalize CX48 with result in C0,C1,C2
; Distribute the 24 bits of the first 3 bytes (for
; the top part of a tall char.) or the last 3 (for
; the bottom part) among c0,c1,c2
decanon:
    lxi    h,cx48
    lda    tabottom
    ora    a
    jz    dcnn0
    lxi    h,cx48+3
dcnn0:    mov    d,m
    inx    h
    mov    e,m
    inx    h
    mov    l,m
    xchg
    lda    cheight
    cpi    3*24
    jc    dcnn1
    mov    a,h
    sta    c0
    mov    a,l
    sta    c1
    mov    a,e
    sta    c2
    ret
dcnn1:    mvi    b,8
dcnn2:    call    dshft
    mov    a,c
    ral
    mov    c,a
    call    dshft
    mov    a,d
    ral
    mov    d,a
    call    dshft
    lda    c2
    ral
    sta    c2
    dcr    b
    jnz    dcnn2
    mov    a,d
    sta    c1
    mov    a,c
    sta    c0
    ret

;collect bits in C from 24 bits in H-L-E
shft:
    mov    a,h
    ral
    mov    h,a
    mov    a,c
    ral
    mov    c,a
    dcr    b
    rz
shft3:    mov    a,l
    ral
    mov    l,a
    mov    a,c
    ral
    mov    c,a
    dcr    b
    rz
shft2:    mov    a,e
    ral
    mov    e,a
    mov    a,c
    ral
    mov    c,a
    dcr    b
    rz
    jmp    shft

;rotate left 24 bits in H-L-E, returning
; with high bit in carry
dshft:
    mov    a,e
    ral
    mov    e,a
    mov    a,l
    ral
    mov    l,a
    mov    a,h
    ral
    mov    h,a
    ret

;if character height > 8 points, stretch pattern accordingly
hidots:
    lda    cheight
    cpi    3*24
    jc    hdts0
    rz
;for >= 24 points, use points instead of dots
    mov    l,a
    mvi    h,0
    lxi    d,3
    xchg
    call    USDIV
    mov    a,l
hdts0:
    sui    3*8
    rm
    cpi    3*8+1
    rnc

    mov    e,a
    lxi    h,sttab
    lda    ta
    dcr    a
    jnz    hidots2
    inr    e
hidots1:
    dcr    e
    rz
    mov    c,m    ;load byte offset and bit mask
    inx    h
    mov    b,m
    inx    h
    push    d
    push    h
    call    stret
    pop    h
    pop    d
    jmp    hidots1

hidots2:
    dcr    a
    mov    a,e
    jz    $+9
;here tall was >= 3
    lxi    b,041FH    ;row 35
    jmp    hirowb

;;    mov    a,e
    ora    a
    rar
    ora    a
    jnz    hdts2a
    inr    a
hdts2a:
;(new version)
    push    psw
    lxi    b,037FH
    call    hirowb
    pop    psw
    lxi    b,0503H

;;    mov    e,a
;;    mov    d,a
;;hidots3:
;;    lxi    b,037FH    ;25th row
;;    push    d
;;    call    stret
;;    pop    d
;;    dcr    e
;;    jnz    hidots3
;;hidots4:
;;    lxi    b,0503H    ;46th row
;;    push    d
;;    call    stret
;;    pop    d
;;    dcr    d
;;    jnz    hidots4
;;    ret

hirowb:
    push    psw
    push    b
    call    stret
    pop    b
    pop    psw
    dcr    a
    jnz    hirowb
    ret

;stretch out pattern in cx48 by doubling one bit
; the bit is in the byte at offset B, and a mask
; for the lesser bits to remain unaffected is in C
stret:
    lxi    h,cx48
    mov    e,b
    mvi    d,0
    dad    d    ;HL-> highest byte to change
    mov    a,m
    mov    e,a    ;E = original
    ana    c    ;use mask
    mov    d,a    ;D = bits to save
    mov    a,c    ;invert mask for bits to change
    xri    0FFH
    mov    c,a
    mov    a,e
    ral
    ana    c    ;A = new rotated bits
    ora    d    ;restore old saved bits
    mov    m,a    ;now lowest order byte is ready
            ; and e still has original (for b7)
stret1:
    dcr b
    rm        ;if just did lowest byte, done
    dcx    h    ;-> next lower byte
    mov    a,e    ;get b7 of last in carry
    ral
    mov    a,m    ;get the original
    mov    e,a    ;save for sake of b7
    ral
    mov    m,a    ;change it
    jmp    stret1

;Table contains list of bits to double, in
; increasing order of priority
; First byte of each 2 byte entry is a mask
; for the low order bits to remain unaffected
; (which will include the doubled bit),
; and high byte is offset = 0,1,2,3,4,5 of the
; byte in cx48 where the doubled bit is to be found
;Present table values just to test
sttab:
    db    0FFH shr (27 mod 8), 27 / 8
    db    0FFH shr (35 mod 8), 35 / 8
    db    0FFH shr (45 mod 8), 45 / 8
; 9 points
    db    0FFH shr (36 mod 8), 36 / 8
    db    0FFH shr (21 mod 8), 21 / 8
    db    0FFH shr (30 mod 8), 30 / 8
;10 points
    db    0FFH shr (42 mod 8), 42 / 8
    db    0FFH shr (37 mod 8), 37 / 8
    db    0FFH shr (23 mod 8), 23 / 8
;11 points
    db    0FFH shr (25 mod 8), 25 / 8
    db    0FFH shr (47 mod 8), 47 / 8
    db    0FFH shr (38 mod 8), 38 / 8
;12 points
    db    0FFH shr (15 mod 8), 15 / 8
    db    0FFH shr (30 mod 8), 30 / 8
    db    0FFH shr (42 mod 8), 42 / 8
;13 points
    db    0FFH shr (25 mod 8), 25 / 8
    db    0FFH shr (15 mod 8), 15 / 8
    db    0FFH shr (32 mod 8), 32 / 8
;14 points
    db    0FFH shr (38 mod 8), 38 / 8
    db    0FFH shr (19 mod 8), 19 / 8
    db    0FFH shr ( 4 mod 8),  4 / 8
;15 points
    db    0FFH shr (34 mod 8), 34 / 8
    db    0FFH shr (45 mod 8), 45 / 8
    db    0FFH shr (13 mod 8), 13 / 8
;16 points

    END