Black Box 4/BlackBox.cdr/clipper/arcvie.arj/ARC_VIEW.PRG

Text File | 1992-06-05 | 5.3 KB | 155 lines

/*
    ARC_VIEW.PRG
    Author:  Eric J. Givler
    Date:    06/05/92
    Purpose: View .ARC, .LZH, .ZIP, .ZOO.  Will support more later.
             secondfile option added as quick-kludge to show off multi-browse.
*/
#include "box.ch"
#include "inkey.ch"


FUNCTION Main( filetoview, secondfile )
LOCAL lmissing := .F., ncursor := setcursor(0)

    if ! empty( filetoview ) .and. (lmissing := file(filetoview))
        File_Viewer({ filetoview, secondfile })
    else
        ? 'ARC_VIEW 1.0, (c)1991,1992, Eric J. Givler, All Rights Reserved.'
        ? 'Supports ARC, LZH, ZIP, ZOO files.'
        ? 'Syntax: ARC_VIEW <arcname>'
        ? 'Error: ' + if(lMissing, '<File not found>', '<Argument Missing>')
    endif
    setcursor(ncursor)

RETURN NIL


STATIC FUNCTION FILE_VIEWER( aFiles_ )
LOCAL cType, i, nkey, ncursor := setcursor()
LOCAL b1, b2, cb, nCb, contents_, elems := len( aFiles_ ), index1, index2
LOCAL scrn, cCol := setcolor(), c_ := { "W/B,GR+/R", "W+/RB,W+/BG" }

    if elems > 2 .or. valtype(aFiles_) != "A"
        return NIL
    endif

    contents_ := array(elems)
    for i := 1 to elems
        cType := upper(right(aFiles_[i], 3))
        do case
            case cType == "ARC"
                contents_[i] := ArcDir( aFiles_[i] )
            // case cType == "ARJ"
            //    contents_[i] := ArjView( aFiles_[i] )
            case cType == "LZH"
                contents_[i] := LzhDir( aFiles_[i] )
            case cType == "ZIP"
                contents_[i] := ZipDir( aFiles_[i] )
            case cType == "ZOO"
                contents_[i] := ZooDir( aFiles_[i] )
        endcase
        if empty( contents_[i] )
            adel( contents_[i] )
            asize( contents_, len(contents_) -1)
        endif
    next i

    if empty( contents_ )
        return NIL
    endif

    scrn  := savescreen( 0, 0, maxrow(), maxcol() )
    elems := len( contents_ )
    //---------------------[ Set up first browse ]--------------------------
    index1 := 1
    nCb := 1
    setcolor(c_[1])
    b1 := tbrowsenew( 8, 1, 23, if(elems==1, 78,38) )
    dispbox(b1:nTop-1,b1:nLeft-1,b1:nBottom+1,b1:nRight+1, ;
            B_DOUBLE)
    @ b1:nTop-1,b1:nLeft+1 say left(aFiles_[1],35)
    b1:headsep := "═╤═"
    b1:colsep  := " │ "
    // b1:footsep := "═╧═"
    // b1:colorspec := m->c_normcol
    b1:gotopblock    := { || index1 := 1 }
    b1:gobottomblock := { || index1 := len( contents_[1] ) }
    b1:skipblock := { |n| ArraySkip( len( contents_[1] ), @index1, n ) }
    b1:addcolumn( tbcolumnnew( "Filename",   { || contents_[1][index1][1] } ))
    b1:addcolumn( tbcolumnnew( "Compressed", { || contents_[1][index1][2] } ))
    b1:addcolumn( tbcolumnnew( "UnCompress", { || contents_[1][index1][3] } ))
    b1:addcolumn( tbcolumnnew( "FileDate",   { || contents_[1][index1][4] } ))
    b1:getcolumn(1):width := 12
    b1:getcolumn(2):width := 10
    b1:getcolumn(3):width := 10
    b1:getcolumn(4):width :=  9

    if elems > 1
        index2 := 1
        setcolor(c_[2])
        b2 := tbrowsenew(8, 41, 23, 78)
        dispbox(b2:nTop-1,b2:nLeft-1,b2:nBottom+1,b2:nRight+1, ;
            B_SINGLE)
        @ b2:nTop-1,b2:nLeft+1 say left(aFiles_[2],35)
        b2:headsep := "═╤═"
        b2:colsep  := " │ "
        // b2:footsep := "═╧═"
        // b2:colorspec := "W+/RB,W+/BG"
        b2:gotopblock    := { || index2 := 1 }
        b2:gobottomblock := { || index2 := len( contents_[2] ) }
        b2:skipblock := { |n| ArraySkip( len( contents_[2] ), @index2, n ) }
        b2:addcolumn( tbcolumnnew( "Filename",   { || contents_[2][index2][1] } ))
        b2:addcolumn( tbcolumnnew( "Compressed", { || contents_[2][index2][2] } ))
        b2:addcolumn( tbcolumnnew( "UnCompress", { || contents_[2][index2][3] } ))
        b2:addcolumn( tbcolumnnew( "FileDate",   { || contents_[2][index2][4] } ))
        b2:getcolumn(1):width := 12
        b2:getcolumn(2):width := 10
        b2:getcolumn(3):width := 10
        b2:getcolumn(4):width :=  9
    endif

    if elems > 1
        cb := b2
        do while ! cb:stabilize()
        enddo
        cb:dehilite()
    endif
    cb := b1

    do while .t.

        do while ! cb:stabilize()
        enddo

        nKey := inkey(0)
        if StdMeth(nKey, cb)
            // The previous function handles standard Tbrowse keystrokes.
            loop
        else
            do case
                case nKey == K_TAB
                    if elems > 1
                        dispbox(cb:nTop-1,cb:nLeft-1,cb:nBottom+1,cb:nRight+1,;
                           B_SINGLE, c_[nCb])
                        @ cb:nTop-1,cb:nLeft+1 say left(aFiles_[nCb],35) color c_[nCb]
                        nCb := if(nCb == 1, 2, 1)
                        cb:dehilite()
                        cb  := if(nCb == 1, b1, b2)
                        cb:hilite()
                        dispbox(cb:nTop-1,cb:nLeft-1,cb:nBottom+1,cb:nRight+1,;
                           B_DOUBLE, c_[nCb])
                        @ cb:nTop-1,cb:nLeft+1 say left(aFiles_[nCb],35) color c_[nCb]
                    endif

                case nKey == K_ESC
                    exit
            endcase
        endif
    enddo

    setcursor(ncursor)
    restscreen( ,,,, scrn )

RETURN NIL