datalist.src

没有说明

    else;
        dlstpau = 0;
    endif;

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

    call seekr(fin,start);
    do while 1;
        nr = nrow;

        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 = k;         /* 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(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 == 81 or ky == 113;       /* Quit */
                goto quit;

            elseif ky == 100;       /* d -> pgDn */
                dflt = 100;
                dfltc = "down";
                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 == 117;       /* u -> pgUp */
                dflt = 117;
                dfltc = "up";
                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 == 85 or ky == 45;    /* U,- -> up */
                dflt = ky;
                if dflt == 85;
                    dfltc = "Up";
                else;
                    dfltc = "-";
                endif;
                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 == 68 or ky == 43;    /* D,+ -> down */
                dflt = ky;
                if dflt == 68;
                    dfltc = "Down";
                else;
                    dfltc = "+";
                endif;
                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 == 84 or ky == 116;           /* T,t -> Top */
                dflt = 84;
                dfltc = "Top";
                call seekr(fin,1);
                counter = 0;

            elseif ky == 66 or ky == 98;    /* B,b -> Bottom */
                dflt = 66;
                dfltc = "Bottom";
                if rmax < nrow;
                    call seekr(fin,1);
                    counter = 0;
                else;
                    call seekr(fin,rmax-nrow+1);
                    counter = seekr(fin,-1)-1;
                endif;

            elseif ky == 79 or ky == 111;           /* Options */

                dfltc = "Quit";
                print /flush "Precision  Width  Columns  Rows  Quit  ["
                    dfltc "] ";;
                ky = 0;
                do while ky == 0;

                    do until ky;
                        ky = key;
                    endo;

                    if ky == 13 or ky == 81 or ky == 113;
                        dflt = 79;
                        dfltc = "Options";
                        counter = start-1;

                    elseif ky == 80 or ky == 112;
                        print "Precision : ";;
                        s = cons;
                        if strlen(s) > 0;
                            v = stof(s);
                            if v > 0 and v < 17;
                                dlstdgt = v;
                                counter = start-1;
                            endif;
                        endif;

                    elseif ky == 87 or ky == 119;
                        print "Column width : ";;
                        s = cons;
                        if strlen(s) > 0;
                            v = stof(s);
                            if v > 0 and v < 51;
                                colper = v;
                                counter = start-1;
                            endif;
                        endif;

                    elseif ky == 67 or ky == 99;
                        print "Number of columns : ";;
                        s = cons;
                        if strlen(s) > 0;
                            v = stof(s);
                            if v > 0 and v < 101;
                                ncol = minc(v|cols(x));
                                counter = start-1;
                            endif;
                        endif;

                    elseif ky == 82 or ky == 114;
                        print "Number of rows : ";;
                        s = cons;
                        if strlen(s) > 0;
                            v = stof(s);
                            if v > 0 and v <= 101;
                                nrow = minc(v|rmax);

                                rpos = seekr(fin,-1);
                                if rpos+1 > rmax;
                                    call seekr(fin,maxc(1|rmax-nr+1));
                                elseif not eof(fin);
                                    call seekr(fin,maxc(1|rpos-nr));
                                else;
                                        /* call seekr(fin,maxc(1|rpos-
                                        :: nrow));
                                        */
                                    errorlog "ERROR:  Internal Error 129";
                                endif;
                                counter = seekr(fin,-1)-1;
                            endif;
                        endif;

                    else;
                        ky = 0;

                    endif;
                endo;
            else;
                goto skipkey;
            endif;

        endif;
        start = counter+1;
        call seekr(fin,start);
    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;

    klist = {
        85,117,  /* U, u */
        68,100,  /* D, d */
        76,108,  /* L, l */
        82,114,  /* R, r */
        84,116,  /* T, t */
        66,98,   /* B, b */
        72,104,  /* H, h */
        69,101,  /* E, e */
        79,111,  /* O, o */
        43,45,   /* +, - */
        63,      /* ?    */
        81,113   /* Q, q */
        };

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

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

        /* 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 /flush "Up  Down  Left  Right  Top  Bottom  Home  End  "
                "Options  +  -  ?  Quit  [" dfltc "] ";;
            ky = 0;
            do until ky;
                ky = key;
            endo;

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

            if ky == 81 or ky == 113;
                goto quit;

            elseif ky == 82;        /* R -> col right */
                cnprt = minc(ncol|cols(mat));
                cstrt = cstrt-cnprt+1;
                if cstrt > cols(mat)-cnprt+1;
                    cstrt = cols(mat)-cnprt+1;
                endif;
                dflt = 82;
                dfltc = "Right";

            elseif ky == 76;        /* L -> col left */
                cnprt = minc(ncol|cols(mat));
                cstrt = cstrt-cnprt-1;
                if cstrt < 1;
                    cstrt = 1;
                endif;
                dflt = 76;
                dfltc = "Left";

            elseif ky == 114;       /* r -> page right */
                cnprt = minc(ncol|cols(mat));
                if cstrt > cols(mat)-cnprt+1;
                    cstrt = cols(mat)-cnprt+1;
                endif;
                dflt = 114;
                dfltc = "right";

            elseif ky == 108;       /* l -> page left */
                cnprt = minc(ncol|cols(mat));
                cstrt = cstrt - 2*cnprt;
                if cstrt < 1;
                    cstrt = 1;
                endif;
                dflt = 108;
                dfltc = "left";

            elseif ky == 72 or ky == 104;           /* Home */
                cstrt = 1;
                cnprt = minc(ncol|cols(mat));
                dflt = 72;
                dfltc = "Home";

            elseif ky == 69 or ky == 101;           /* End */
                cnprt = minc(ncol|cols(mat));
                cstrt = cols(mat)-cnprt+1;
                dflt = 69;
                dfltc = "End";

            elseif ky == 63;        /* ? */
                print;
                print;
                print "Datalist Commands :";
                print;
                print "u    page Up";
                print "d    page Down";
                print "l    page Left";
                print "r    page Right";
                print;
                print "U,+  up    1 row";
                print "D,-  down  1 row";
                print "L    left  1 column";
                print "R    right 1 column";
                print;
                print "T,t  top row";
                print "B,b  bottom row";
                print "H,h  home column";
                print "E,e  end column";
                print;
                print "O,o  options menu";
                print "Q,q  quit";
                print;
                print "Options:";
                print "   P,p  set precision";
                print "   W,w  set column width";
                print "   C,c  set # of columns";
                print "   R,r  set # of rows";
                print;
                print "Press Return to continue...";
                print;
                print;
                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;

                retp(ky,cstrt);
            else;
                goto skipkey;
            endif;

        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;

    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