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

Text File | 1988-05-21 | 9.6 KB | 736 lines

    include    BDS.LIB
    include    EPDATA

    .request EPEXEC

    .comment    `
functions EPSINIT, EPERROR, LOADFT


/************************************************/
/*    Initialization of Epson & other things    */
/************************************************/
epsinit()
{    int i;

    loadi(0); /* initialize values using 'ep.ini';
            sets mode and tabwid */
    emode = tallflag = 0;
    pn = 1;

    outbuf = xoutbuf;
    attrbuf = xattrbuf;
    widbuf = xwidbuf;

    newinline();
    newoutline();

    spdots = skdots = 0;
    vposition = tm;

    brccount = brcpt[0] = 0;

    PTESCCH('@');        /* Epson master reset        */
    unidir = FALSE;


/* This was for broken 8th bit on Sluder
    PTESCCH('=');
*/

    mreset(mode);

    newfonts();
}

            `

epsinit::

;    loadi(0); /* initialize values using 'ep.ini';
;            sets mode and tabwid */

    lxi    h,0
    push    h
    call    loadi##
    pop    d
;    emode = tallflag = 0;
    xra    a
    sta    tallflag
    lxi    h,0
    shld    emode    ;done by mreset(0) below?
;    pn = 1;
    inx    h
    shld    pn
;
;    outbuf = xoutbuf;
;    attrbuf = xattrbuf;
;    widbuf = xwidbuf;

    lxi    h,xoutbuf
    shld    outbuf
    lxi    h,xattrbuf
    shld    attrbuf
    lxi    h,xwidbuf
    shld    widbuf
;
;    newinline();
;    newoutline();
    call    newinline##
    call    newoutline##
;
;    spdots = skdots = 0;
    lxi    h,0
    shld    skdots
;??    shld    spdots (not currently used)

;    vposition = tm;
;;; - hm
;
;    lhld    tm
;    xchg
;    lhld    hm
;    call    cmh
;    dad    d
    lxi    h,-1    ;HM now 0 -- paperup will init this
    shld    vposition

;    brccount = brcpt[0] = 0;
    lxi    h,0
    shld    brcpt
    shld    brccount
;
;    PTESCCH('@');        /* Epson master reset        */

;call mreset first to init bios vector in presc routine
    lxi    h,0
    push    h
    call    mreset##
    pop    d

    mvi    a,'@'
    call    presc1##

;    unidir = FALSE;
    mvi    a,0
    sta    unidir
;
;    mreset(mode);
    lhld    mode
    push    h
    call    mreset##
    pop    d
;
;    newfonts();
;}
    jmp    newfonts##

    .comment    `

eperror(errn)
int errn;
{    errcode = errn;
    exec("EPERROR");
    puts("\n\nERROR\n");
    exit(ERROR);
}

            `

eperror::
    pop    d
    pop    h
    shld    errcode

;    lxi    h,$errprog
;    push    h
;    call    exec##
    call    epexec##

    lxi    h,$errmsg
;    push    h
    call    puts##

    lxi    h,-1
    push    h
;    call    exit##    ;or call exit ??
    call    .exit

;$errprog:
;    db    'EPERROR',0
$errmsg:
    db    0AH,0AH,'ERROR',0AH,0



    .comment    `

/************************************************/
/* Load in from disk one font of graphics data    */
/************************************************/
loadft(fntreq)
int fntreq;
{
    int fdft, i, k, ftrecs;
    char fullname[17];

    /* if no more room, load over last font        */
    if (fntreq == NUMFTS)
    {    fntreq--;
        free(ftp[fntreq]);
        ftp[fntreq] = 0;
    }

    /* maybe already loaded?            */
    if (ftp[fntreq]) return(0);

    errtype = fntreq;
    fprefix(fullname);

    strcat(fullname,ftname[fntreq]);
    strcat(fullname,".FN2");

    if ((fdft = open(fullname,0)) == ERROR)
        {puts("\nno font\n"); eperror(120+fntreq);}

    /* read the index to where data for each char is    */
    if (read(fdft, fix[fntreq], 2) != 2)
        {puts("\nbad font\n"); eperror(130+fntreq);}

    /* only read enough of the font to get info for char's
        up to ascii nul (which is not used)        */
    ftrecs = (fix[fntreq][127]+127)/128;

    /* get memory space -- overwrite old fonts, if necessary    */
    k = nextft - 1;
    while
    (    !(ftp[fntreq] = alloc(ftrecs * 128))
        && k > 0
    )
    {    if (k == fntreq) { k--; continue; }
        if (ftp[k]) free(ftp[k]);
        ftp[k] = 0;
        k--;
    }

    /* this should never happen                */
    if (!ftp[fntreq]) eperror(111);

    if (read(fdft, ftp[fntreq], ftrecs) != ftrecs)
        eperror(130+fntreq);

    fabort(fdft);

    /* calculate widths of characters for later reference    */
    ftlen[fntreq][0] = 0;
    for (i = 1; i < 127; i++)
        ftlen[fntreq][i] = (fix[fntreq][i+1] - fix[fntreq][i])/3;

    return(0);
}

            `


loadft::
    pop    d
    pop    h
    push    h
    push    d

    push    b
;B = fntreq
    mov    b,l

;    /* if no more room, load over last font        */
;    if (fntreq == NUMFTS)

    mov    a,b
    cpi    NUMFTS
    jnz    .ldf1

;    {    fntreq--;

    dcr    b
    dcr    l

;        free(ftp[fntreq]);

;HL still = fntreq
    dad    h
    lxi    d,ftp
    dad    d
    push    h    ;for next stmt

    mov    e,m
    inx    h
    mov    d,m
;check if allocated?
;    push    d
    xchg
    call    free##
;    pop    d

;        ftp[fntreq] = 0;
;    }
    pop    h
    xra    a
    mov    m,a
    inx    h
    mov    m,a
;
;    /* maybe already loaded?            */
;    if (ftp[fntreq]) return(0);

.ldf1:
    mov    l,b
    mvi    h,0
    dad    h
    lxi    d,ftp
    dad    d
    mov    a,m
    inx    h
    ora    m
    jz    .ldf2
    lxi    h,0
    pop    b
    ret

;
;    errtype = fntreq;
.ldf2:
    mov    l,b
    mvi    h,0
    shld    errtype

;if drive prefix was stored with name, don't add another
    call    getftn##
;(2 copies for later)
    push    h
    push    h
    inx    h
    mov    a,m
    cpi    ':'


;    fprefix(fullname);
    lxi    h,fullname
;nul in case go directly to strcat
    mvi    m,0
;well, was it a colon? then don't get def. prefix
    jz    .ldf2a
    push    h
    call    fprefix##
    pop    d
.ldf2a:
;first copy ftname ptr (one still on stack)
    pop    h
;
;    strcat(fullname,ftname[fntreq]);
;    call    getftn##
;    push    h

    mov    a,m
    ani    80h
    sta    itsagf
    mov    a,m
    push    psw
    ani    7fh
    mov    m,a

    xchg
    lxi    h,fullname

    call    strcat##

    pop    psw
;use 2nd copy of ftname ptr to restore 1st char as was
    pop    h
    mov    m,a

;    strcat(fullname,".FN2");

    lxi    d,$xtbtp
;    lda    itsagf
;    ora    a
    ani    80h
    jnz    $+6
    lxi    d,$xtfn2

    lxi    h,fullname
    call    strcat##

;
;    if ((fdft = open(fullname,0)) == ERROR)
    lxi    h,0
    push    h
    lxi    h,fullname
    push    h
    call    open##
    pop    d
    pop    d
    shld    fdft
    inx    h
    mov    a,h
    ora    l
    jnz    .ldf3
;        {puts("\nno font\n"); eperror(120+fntreq);}
    lxi    h,$no_font
    call    puts##
    lxi    d,120
.ldf2b:    mov    l,b
    mvi    h,0
    dad    d
    push    h
    call    eperror

;
;    /* read the index to where data for each char is    */
;    if (read(fdft, fix[fntreq], 2) != 2)
.ldf3:
    lxi    h,2
    push    h

    mov    h,b
    mvi    l,0    ;fntreq*100h
    lxi    d,fix
    dad    d

    lda    itsagf
    ora    a
    jz    .ldf3a
    pop    d    ;discard 2 (rec count)
    call    fixfake
    jmp    .ldf4
.ldf3a:
    push    h

    lhld    fdft
    push    h
    call    read##
    pop    d
    pop    d
    pop    d

    dcx    h
    dcx    h
    mov    a,h
    ora    l
    jz    .ldf4
;        {puts("\nbad font\n"); eperror(130+fntreq);}
    lxi    h,$bad_font
;    push    h
    call    puts##
;    pop    d
    lxi    d,130
    jmp    .ldf2b

;
;    /* only read enough of the font to get info for char's
;        up to ascii nul (which is not used)        */
;    ftrecs = (fix[fntreq][127]+127)/128;
.ldf4:
    mov    h,b
    mvi    l,0
    lxi    d,fix + 127*2
    dad    d

    mov    e,m
    inx    h
    mov    d,m

    lxi    h,127
    dad    d
    push    h
    xchg
    lxi    h,128
    call    usdiv

    shld    ftrecs
    pop    h
    mvi    a,80h
    ana    l
    mov    l,a
    shld    ftbytes
;
;    /* get memory space -- overwrite old fonts, if necessary    */
;    k = nextft - 1;
;C = k
    lda    nextft
    dcr    a
    mov    c,a

;    while
;    (    !(ftp[fntreq] = alloc(ftrecs * 128))
;        && k > 0
;    )
.ldf5:
    mov    l,b
    mvi    h,0
    dad    h
    lxi    d,ftp
    dad    d
    push    h

    lhld    ftbytes
;    push    h
    call    alloc##
;    pop    d

    xchg
    pop    h
    mov    m,e
    inx    h
    mov    m,d

    mov    a,d
    ora    e
    jnz    .ldf8a

    mov    a,c
    ora    a
    jz    .ldf8

;    {    if (k == fntreq) { k--; continue; }

    cmp    b
    jnz    .ldf6
    dcr    c
    jmp    .ldf5

;        if (ftp[k]) free(ftp[k]);
.ldf6:
    mov    l,c
    mvi    h,0
    dad    h
    lxi    d,ftp
    dad    d
    push    h    ;for next stmt
    mov    e,m
    inx    h
    mov    d,m
    mov    a,d
    ora    e

;    push    d
    xchg
    cnz    free##
;    pop    d
;        ftp[k] = 0;
.ldf7:
    pop    h
    xra    a
    mov    m,a
    inx    h
    mov    m,a
;        k--;
;    }

    dcr    c
    jmp    .ldf5
;
;    /* this should never happen                */
;    if (!ftp[fntreq]) eperror(111);
.ldf8:
;to here from above only if nothing allocated, and k = 0
    lxi    h,111
    push    h
    call    eperror

.ldf8a:
;
;    if (read(fdft, ftp[fntreq], ftrecs) != ftrecs)
;        eperror(130+fntreq);
.ldf9:
    lhld    ftrecs
    push    h

    mov    l,b
    mvi    h,0
    dad    h
    lxi    d,ftp
    dad    d
    mov    e,m
    inx    h
    mov    d,m
    push    d

    lhld    fdft
    push    h
    call    read##
    pop    d
    pop    d
    pop    d

    xchg
    lhld    ftrecs
    call    eqwel
    jz    .ldf10

    mov    l,b
    mvi    h,0
    lxi    d,130
    dad    d
    push    h
    call    eperror

;
;    fabort(fdft);
.ldf10:
;    lhld    fdft
;    push    h
    lda    fdft
    call    fabort##
;    pop    d
;
;    /* calculate widths of characters for later reference    */
;    ftlen[fntreq][0] = 0;

    mov    l,b
    mvi    h,0
;    lxi    d,128
;    call    usmul
    dad    h
    dad    h
    dad    h
    dad    h
    dad    h
    dad    h
    dad    h

    lxi    d,ftlen
    dad    d
    mvi    m,0
    lda    itsagf
    ora    a
    jnz    lenfake

;    for (i = 1; i < 127; i++)
;C = i
    mvi    c,1

.ldf11:
    mov    a,c
    cpi    127
    jnc    .ldf12

;        ftlen[fntreq][i] = (fix[fntreq][i+1] - fix[fntreq][i])/3;

;    mov    l,b
;    mvi    h,0
;    lxi    d,128
;    call    usmul
;    lxi    d,ftlen
;    dad    d

    inx    h
    push    h

    mov    h,b
    mvi    l,0
    lxi    d,fix
    dad    d
    xchg

;i
    mov    l,c
    mvi    h,0
;word array
    dad    h

    dad    d
    mov    e,m
    inx    h
    mov    d,m
;DE = fix[fntreq][i]

    push    d
    inx    h
    mov    e,m
    inx    h
    mov    d,m
    xchg
;HL = fix[fntreq][i+1]

    pop    d
;- fix[fntreq][i]
    call    cmd
    dad    d

    lxi    d,3
    xchg
    call    usdiv

    xchg
    pop    h
    mov    m,e

    inr c
    jmp    .ldf11

;
;    return(0);
;}
.ldf12:    lxi    h,0
.ldf13:
    pop    b
    ret

;make up char lens for graphics font -- each is 0ffh
;HL points to the ftlen for this font on entry
lenfake:
    xra    a
    mvi    c,0ffh
    mov    b,a
.lfak1: mov    m,b
    cpi    '@'
    jc    .lfak2
    cpi    '@'+40
    jnc    .lfak2
    mov    m,c
.lfak2:
    inx    h
    inr    a
    cpi    128
    jnz    .lfak1
    jmp    .ldf12

;make up a directory for graphics font
;HL points to the fix for this font on entry
fixfake:
    push    b
    xra    a
    lxi    d,0
    lxi    b,450
.ffak1:    mov    m,e
    inx    h
    mov    m,d
    inx    h
    cpi    '@'
    jc    .ffak2
    cpi    '@'+40
    jnc    .ffak2
    xchg        ;if char in range, len was 450
    dad    b
    xchg
.ffak2:
    inr    a
    cpi    128
    jnz    .ffak1
    pop    b
    ret

$xtfn2:        db    '.FN2',0
$xtbtp:        db    '.BTP',0
itsagf:        db    0
$no_font:    db    0AH,'no font',0AH,0
$bad_font:    db    0AH,'bad font',0AH,0

ftrecs:        dw    0
ftbytes:    dw    0
fdft:        dw    0
;fullname:    ds    17

    end