datalist.src

没有说明

                retp(ky,cstrt);
            else;
                goto skipkey;
            endif;
            cls;
        endif;
    endo;
    ndpclex;
    call formatnv(oldnfmt);
    call formatcv(oldcfmt);
    retp(0,cstrt);
quit:

    call formatnv(oldnfmt);
    call formatcv(oldcfmt);
    ndpclex;
    retp(1,1);
endp;

proc (0) = _cntrprt(row,str,pv);
    local pad;
    locate row,1;
    if str $== "";
        print /flush chrs(zeros(80,1)+pv);;
    else;
        pad = chrs(zeros(floor((80-strlen(str))/2)-2,1)+pv);
        print /flush pad " " str " " pad;;
    endif;
endp;

#endif

#ifDOS

proc (0) = _dtlist(infile, vname, dgt, np);

    local colper,fin,flag,inindx,invar,k,ky, nrow,ncol,dcol,dflt, vtype,nr,
        start,outlbl,qq,rlbl,tx,x,nm,rmax,dfltc, csrold,dlstpau,dlstdgt,
        lastobs,counter,rpos,cstrt;
    cstrt = 1;
    csrold = csrtype(0);
    clear dlstpau;
    fin = -1;
    flag = 1;
    dflt = 27;
    nrow = 20;

    dcol = 65;
    dfltc = "Esc";
    cls;

    infile = "" $+ infile;
    open fin = ^infile;
    if fin == -1;
        errorlog "ERROR:  Can't open file " $+ infile $+ ".";
        ndpclex;
        print;
        call csrtype(csrold);
        retp;
    endif;
    if vname == 0;
        invar = getname(infile);
    else;
        invar = vname;
    endif;
    { nr,start,counter,lastobs } = _rngchk(infile,__range);

    rmax = rowsf(fin);
    if rmax > lastobs;
        rmax = lastobs;
    endif;

    dlstdgt = dgt;
    if np == 0;
        dlstpau = 1;
        nr = nrow;
    else;
        dlstpau = 0;
    endif;

    { nm, inindx } = indices(infile, invar);
    { outlbl,vtype } = nametype(nm,__vtype);

    call seekr(fin,start);
    do while 1;

        x = readr(fin,nr);
        x = x[.,inindx];
        counter = counter+rows(x);
        if counter > lastobs;
            x = trimr(x, 0, counter-lastobs);
        endif;
        if __miss == 1;
            x = packr(x);
        endif;
        if scalmiss(x);
            continue;       /* no observations returned */
        endif;

        if flag;
            if vtype == 0;
                colper = 10;
            else;
                tx = packr(miss(vtype,0)~x')';
                k = 2+strlen(ftos( maxc(maxc(tx)),"#*.*lG",1,dlstdgt));
                clear tx;
                colper = maxc(k|10);        /* columns per number */
                if colper > dcol;
                    colper = dcol;
                endif;
            endif;
            ncol = trunc(dcol/colper);      /* number of columns */
            flag = 0;
        endif;

        rlbl = 0$+"#"$+ftocv(seqa(start,1,rows(x)),1,0);
        { qq,cstrt } = _dtwrt(upper(infile),x,rlbl,outlbl,vtype,dlstpau,
            ncol, colper,dlstdgt,cstrt,dflt,dfltc);
        if qq == 1;
            goto quit;
        endif;
        print;
        if dlstpau;

            if qq > 1;
                ky = qq;
                goto havekey;
            endif;

        skipkey:

            ky = 0;
            do until ky;
                ky = key;
            endo;

            if ky == 13;
                ky = dflt;
            endif;

        havekey:

            if ky == 27;    /* ESC */
                goto quit;

            elseif ky == 1081;      /* PGDN */
                dflt = 1081;
                dfltc = "PgDn";
                rpos = seekr(fin,-1);
                if rpos + nrow == rmax;
                    call seekr(fin,rpos-nrow);
                    counter = seekr(fin,-1)-1;
                elseif rpos == rmax + 1;
                    call seekr(fin,rpos-rows(x));
                    counter = counter - rows(x);
                elseif rpos > rmax;
                    call seekr(fin,rmax-rows(x));
                    counter = counter - rows(x);
                elseif rpos + nrow > rmax;
                    call seekr(fin,rmax-rows(x)+1);
                    counter = seekr(fin,-1)-1;
                endif;

            elseif ky == 1073;      /* PGUP */
                dflt = 1073;
                dfltc = "PgUp";
                rpos = seekr(fin,-1);
                if rpos - 2*nrow < 1;
                    call seekr(fin,1);
                else;
                    call seekr(fin,rpos-2*nrow);
                endif;
                counter = seekr(fin,-1)-1;

            elseif ky == 1072;      /* CURSOR_UP */
                dflt = 1072;
                dfltc "\30";

                rpos = seekr(fin,-1);
                if rpos - nrow - 1 < 1;
                    call seekr(fin,1);
                else;
                    call seekr(fin,rpos-nrow-1);
                endif;
                counter = seekr(fin,-1)-1;

            elseif ky == 1080;      /* CURSOR_DN */
                dflt = 1080;
                dfltc = "\31";

                rpos = seekr(fin,-1);
                if rmax < nrow;
                    call seekr(fin,1);
                elseif rpos+1 > rmax;
                    call seekr(fin,rmax-nrow+1);
                elseif not eof(fin);
                    call seekr(fin,rpos-nrow+1);
                else;
                    call seekr(fin,rpos-nrow);
                endif;
                counter = seekr(fin,-1)-1;

            elseif ky == 1071;      /* HOME */
                dflt = 1071;
                dfltc = "Home";
                call seekr(fin,1);
                counter = 0;

            elseif ky == 1079;      /* END */
                dflt = 1079;
                dfltc = "End";
                if rmax < nrow;
                    call seekr(fin,1);
                    counter = 0;
                else;
                    call seekr(fin,rmax-nrow+1);
                    counter = seekr(fin,-1)-1;
                endif;

            else;
                goto skipkey;
            endif;
            cls;

        endif;
        start = counter+1;
    endo;

quit:

    if fin > 0;
        fin = close(fin);
    endif;
    ndpclex;
    call csrtype(csrold);
    retp;

endp;

proc (2) = _dtwrt(lbl,mat,rlbl,clbl,ctyp,pause,ncol, colper,dlstdgt,cstrt,
    dflt,dfltc);

    local lcnprt,cnprt,cslct,fmt,ky,msk,pcsn,oldnfmt,oldcfmt,klist;

    /* Home,End, PgDn,PgUp,down,up, rt, lft, ^rt, ^lft,? */
    klist = { 1071,1079,1081,1073,1080,1072,1075,1077,1115,1116,63 };

    pcsn = dlstdgt;
    cnprt = minc(ncol|cols(mat));
    do while 1;

        /* display the title */
        if strindx(".dat",lower(lbl),1);
            _cntrprt(1,lower(getpath(lower(lbl))),vals("_"));
        else;
            _cntrprt(1,lower(getpath(lower(lbl $+ ".dat"))),vals("_"));
        endif;
        print;

        /* display the data matrix */
        cslct = seqa(cstrt,1,cnprt);
        msk = zeros(1,cnprt+1);
        fmt = "-*.*s"~colper~colper|((zeros(cnprt,1)$+("*.*s"))~
            (zeros(cnprt,1) +(colper~9)));
        if clbl[1,1] ne 0;
            print;
            call printfm(""~clbl[cslct,.]',msk,fmt);
        endif;
        msk = ctyp[cslct];
        print;
        msk = 0~msk';
        oldnfmt = formatnv("#*.*lG"~colper~pcsn);
        oldcfmt = formatcv("*.*s"~colper~colper);
        call printfmt(rlbl~mat[.,cslct],msk);
        if rows(mat) == 1;
            print;
        endif;
        cstrt = cstrt+minc(ncol|cols(mat));
        lcnprt = cnprt;
        cnprt = minc(cnprt|(cols(mat)-cstrt+1));

    skipkey:

        if pause;
            _cntrprt(24,"",vals("_"));

            print "PgDn  PgUp  Home  End  \17  \16  \30  \31  Ctrl-\17" "  "\
                "Ctrl-\16  ?  Esc  [" dfltc "] ";;

            ky = 0;
            do until ky;
                ky = key;
            endo;

            if ky == 13;
                ky = dflt;
            endif;

            if ky == 27;
                goto quit;

            elseif ky == 1116;      /* CTRL_RIGHT */
                dflt = 1116;
                dfltc = "Ctrl-\16";
                cnprt = minc(ncol|cols(mat));
                cstrt = cols(mat)-cnprt+1;

            elseif ky == 1115;      /* CTRL_LEFT */
                dflt = 1115;
                dfltc = "Ctrl-\17";
                cnprt = minc(ncol|cols(mat));
                cstrt = 1;

            elseif ky == 1077;      /* CURSOR_RIGHT */
                dflt = 1077;
                dfltc = "\16";
                cnprt = minc(ncol|cols(mat));
                cstrt = cstrt-cnprt+1;
                if cstrt > cols(mat)-cnprt+1;
                    cstrt = cols(mat)-cnprt+1;
                endif;
            elseif ky == 1075;      /* CURSOR_LEFT */
                dflt = 1075;
                dfltc = "\17";
                cnprt = minc(ncol|cols(mat));
                cstrt = cstrt-cnprt-1;
                if cstrt < 1;
                    cstrt = 1;
                endif;

            elseif ky == 1071;      /* Home */
                cstrt = 1;
                retp(ky,cstrt);

            elseif ky == 1079;      /* End */
                cnprt = minc(ncol|cols(mat));
                cstrt = cols(mat)-cnprt+1;
                retp(ky,cstrt);

            elseif ky == 63;        /* ? */
                print;
                print;
                print "Datalist Commands :";
                print;
                print "PgDn     Page Down";
                print "PgUp     Page Up";
                print "\16        right 1 column";
                print "\17        left  1 column";
                print "\30        up   1 row";
                print "\31        down 1 row";
                print "ctrl-\16   page Right";
                print "ctrl-\17   page Left";
                print "Home     upper left element";
                print "End      lower right element";
                print "Esc      quit";
                print;
                print;
                print "Press Return to continue...";
                ky = 0;
                do until ky;
                    ky = key;
                endo;
                ky = dflt;
                goto skipkey;

            elseif not (ky /= klist);
                if cstrt > cols(mat);
                    cstrt = maxc(1|cols(mat) - ncol + 1);
                else;
                    cstrt = cstrt-ncol;
                endif;
                ndpclex;
                cls;
                retp(ky,cstrt);
            else;
                goto skipkey;
            endif;
            cls;
        endif;
    endo;
    ndpclex;
    call formatnv(oldnfmt);
    call formatcv(oldcfmt);
    retp(0,cstrt);
quit:

    call formatnv(oldnfmt);
    call formatcv(oldcfmt);
    ndpclex;
    retp(1,1);
endp;

proc (0) = _cntrprt(row,str,pv);
    local pad;
    locate row,1;
    if str $== "";
        print chrs(zeros(80,1)+pv);;
    else;
        pad = chrs(zeros(floor((80-strlen(str))/2)-2,1)+pv);
        print pad " " str " " pad;;
    endif;
endp;

#endif

#ifUNIX

proc (0) = _dtlist(infile, vname, dgt, np);

    local colper,fin,flag,inindx,invar,k,ky,n,nrow,ncol,dcol,dflt, vtype,
        nr,start,outlbl,qq,rlbl,tx,x,nm,rmax,dfltc,s,v, csrold,dlstpau,
        dlstdgt,lastobs,counter,rpos,cstrt;
    cstrt = 1;
    csrold = csrtype(0);
    clear dlstpau;
    fin = -1;
    flag = 1;
    dflt = 81;
    nrow = 20;
    ncol = 6;
    dcol = 65;
    dfltc = "Quit";

    infile = "" $+ infile;
    open fin = ^infile;
    if fin == -1;
        errorlog "ERROR:  Can't open file " $+ infile $+ ".";
        ndpclex;
        print;
        call csrtype(csrold);
        retp;
    endif;
    if vname == 0;
        invar = getname(infile);
    else;
        invar = vname;
    endif;
    { nr,start,counter,lastobs } = _rngchk(infile,__range);

    rmax = rowsf(fin);
    if rmax > lastobs;
        rmax = lastobs;
    endif;

    dlstdgt = dgt;
    if np == 0;
        dlstpau = 1;
        nr = nrow;