'
' QBasic File Viewer v1.1
' Written by Zsolt Nagy-Perge, March 2017. zsnp500@cox.net
'
' This is a simple file viewer program which can
' display any kind of text or binary file, but it was
' especially designed for QBasic 1.1 source code files.
'
' Known Limitations:
' You can store 4GB files on a FAT32 file system, however
' this program cannot display 4GB files, because the upper
' limit of the LONG data type in QBasic is 2,147,483,647.
' LONG numbers are used as internal file pointers, so we
' cannot possibly read data beyond the 2GB limit.
' (You can still open 4GB files, but you'll only
' see the first 2GB.) There is also another limitation on
' the number of lines this program can display.
' This program cannot display more than
' 536,870,912 lines of code. This is due to the fact that
' a file pointer is saved for each line, and each file
' pointer takes up 4 bytes.
'

DEFINT A-Z
DECLARE SUB Help ()
DECLARE SUB CountLines ()
DECLARE SUB CreateWindow ()
DECLARE SUB UpdateScreen ()
DECLARE SUB UpdateStatus ()
DECLARE SUB UpdateScrollbar ()
DECLARE FUNCTION GROUP$ (L$, N, S$)
DECLARE FUNCTION kHome ()
DECLARE FUNCTION kEnd ()
DECLARE FUNCTION kCtrlHome ()
DECLARE FUNCTION kPgDn ()
DECLARE FUNCTION kPgUp ()
DECLARE FUNCTION kCtrlEnd ()
DECLARE FUNCTION kUp ()
DECLARE FUNCTION kDown ()

CONST TEMP$ = "TV.TMP"

' If you have a ramdisk, you could use this instead:
'CONST TEMP$ = "Z:\TV.TMP"

DIM SHARED F$

' Read input file name from environment
F$ = ENVIRON$("VIEWFILE")
IF F$ = "" THEN F$ = "VIEWFILE.BAS"

SCREEN 0
WIDTH 80, 25
COLOR 7, 0
LOCATE 1, 1, 0
CLS

ON ERROR GOTO ErrorExit
OPEN F$ FOR INPUT AS #1: CLOSE #1   ' Check if file exists

CONST MAX = 2147483647      ' LONG max value
CONST PAGE = 23             ' number of lines to display per screen

DIM SHARED X&, Y&, P&, PP&, FS#, TABS
DIM SHARED C AS STRING * 1

TABS = 4                    ' number of spaces per TAB character

OPEN F$ FOR BINARY AS 1

FS# = LOF(1)    ' FS# = File size

' Unfortunately, LOF() returns a signed LONG number, which
' means that sometimes when we're looking at a file that is
' bigger than 2GB, then we're going to get a negative number
' for file size! This would screw up the program, so
' here we're going to correct this bug.
 
IF FS# < 0 THEN : FS# = MAX: FS# = FS# * 2 - ABS(LOF(1)) + 2

' Okay, from now on, FS# contains the accurate file size!


R = 1       ' 1=Screen needs to be updated  0=Screen needs no refresh
P& = 1      ' This is the file pointer. It always points to the
            ' first character at the top of the screen

X& = 0      ' Number of characters the window is scrolled right 0=first byte
Y& = 0      ' Number of lines the window is scrolled down 0=first line


' Shared variables for line counter
DIM SHARED LINES&, COUNTING, K&
LINES& = 0    ' Number of total lines counted
COUNTING = 0  ' Line count is in progress
K& = 1        ' File pointer for line counter
IF FS# > 0 THEN COUNTING = 1: LINES& = 1
OPEN TEMP$ FOR BINARY AS #2  ' Store file pointers in temp file

CreateWindow

DO
    IF COUNTING = 1 THEN CountLines
   
    IF R = 1 THEN    ' 1=Refresh screen
        UpdateStatus
        UpdateScreen
        UpdateScrollbar
        R = 0
    END IF

    K$ = INKEY$

    IF K$ = CHR$(27) OR K$ = CHR$(0) + "k" OR K$ = CHR$(0) + "-" THEN CLS : CLOSE : KILL TEMP$: SYSTEM  ' Esc = Alt+X = Alt+F4
    IF K$ = " " OR K$ = CHR$(13) THEN R = kDown  ' Enter = Space = Down Arrow
    IF K$ = CHR$(9) THEN R = kPgDn  ' TAB = PgDn

    SELECT CASE K$
        CASE "-": IF TABS > 0 THEN TABS = TABS - 1: R = 1
        CASE "+": IF TABS < 99 THEN TABS = TABS + 1: R = 1
        CASE CHR$(0) + ";": Help: R = 1
        CASE CHR$(0) + "K": RIGHT = -1
        CASE CHR$(0) + "M": RIGHT = 1
        CASE CHR$(0) + "s": RIGHT = -TABS
        CASE CHR$(0) + "t": RIGHT = TABS
        CASE CHR$(0) + "H": R = kUp
        CASE CHR$(0) + "P": R = kDown
        CASE CHR$(0) + "G": R = kHome
        CASE CHR$(0) + "O": R = kEnd
        CASE CHR$(0) + "w": R = kCtrlHome
        CASE CHR$(0) + "u": R = kCtrlEnd
        CASE CHR$(0) + "I": R = kPgUp
        CASE CHR$(0) + "Q": R = kPgDn
    END SELECT

    IF RIGHT <> 0 THEN
        SAVE& = X&
            X& = X& + RIGHT
            IF X& < 0 THEN X& = 0
        IF SAVE& <> X& THEN R = 1
        RIGHT = 0
    END IF
LOOP


END

ErrorExit:
    CLS
    COLOR 7, 0
    LOCATE 1, 1
    PRINT SPACE$(82);
    IF ERR = 53 THEN PRINT "File not found - "; F$: END
    IF ERR = 76 THEN PRINT "Path not found - "; F$: END
    IF ERR = 70 THEN PRINT "Access denied - "; F$: END
    IF ERR = 64 THEN PRINT "Bad file name - "; F$: END
    PRINT "Oops. Program terminated unexpectedly. ERROR CODE ="; ERR
    PRINT
    END

SUB CountLines
    DIM FP AS STRING * 4   ' Save file pointers in this
    IF FS# > MAX THEN LIMIT& = MAX ELSE LIMIT& = FS#
    PREV = 0
    FOR I = 1 TO 2005
        IF PREV = 0 AND I > 2000 THEN EXIT FOR
        GET #1, K&, C
        A = ASC(C)
        IF A = 10 OR A = 13 THEN
            IF PREV = 0 THEN
                PREV = A: BR = 0
            ELSE
                IF PREV = A THEN BR = 2 ELSE BR = 1
                PREV = 0
            END IF
            IF BR = 2 THEN  ' Count 2 new lines
                FP = MKL$(K&)
                PUT #2, (LINES& - 1) * 4 + 1, FP
                FP = MKL$(K& + 1)
                PUT #2, (LINES&) * 4 + 1, FP
                LINES& = LINES& + 2
                COLOR 0, 7: LOCATE 25, 31: PRINT "Lines:"; LINES&;
                COLOR 7, 0
                BR = 0
            END IF
            IF BR = 1 THEN  ' Count new line
                FP = MKL$(K& + 1)
                PUT #2, (LINES& - 1) * 4 + 1, FP
                LINES& = LINES& + 1
                COLOR 0, 7: LOCATE 25, 31: PRINT "Lines:"; LINES&;
                COLOR 7, 0
            END IF
        ELSE
            IF PREV > 0 THEN
                FP = MKL$(K&)
                PUT #2, (LINES& - 1) * 4 + 1, FP
                LINES& = LINES& + 1
                COLOR 0, 7: LOCATE 25, 31: PRINT "Lines:"; LINES&;
                COLOR 7, 0
            END IF
            PREV = 0
        END IF

        IF K& >= LIMIT& THEN
            ' Save file and reopen for reading
            CLOSE #2: OPEN TEMP$ FOR BINARY AS #2
            COUNTING = 0
            EXIT SUB
        END IF
       
        K& = K& + 1
    NEXT I
END SUB

SUB CreateWindow
    SCREEN 0
    WIDTH 80, 25
    COLOR 7, 0
    CLS

    COLOR 0, 7
    LOCATE 1, 1: PRINT SPACE$(80);
    LOCATE 25, 1: PRINT SPACE$(80);

    ' Print file name
    LOCATE 1, 3
    N$ = F$: IF LEN(N$) > 52 THEN N$ = "..." + RIGHT$(N$, 52)
    PRINT UCASE$(N$);

    ' Print file size
    L$ = GROUP$(LTRIM$(STR$(FS#)), 3, ",") + " byte"
    LOCATE 1, 79 - LEN(L$): PRINT L$;
    IF L# <> 1 THEN PRINT "s";

    UpdateStatus

END SUB

' Insert S$ after every Nth character
FUNCTION GROUP$ (L$, N, S$)

    X$ = ""
    S = 1
    M = LEN(L$) MOD N
    IF M = 0 THEN M = N
    FOR I = M TO LEN(L$) STEP N
        X$ = X$ + MID$(L$, S, M)
        IF I < LEN(L$) THEN
            S = S + M
            M = N
            X$ = X$ + S$
        END IF
    NEXT I
    GROUP$ = X$
END FUNCTION

SUB Help
    FOR I = 0 TO 2000
        DEF SEG = &HB800
        POKE I * 2 + 1, 8  ' dim text
    NEXT I
    COLOR 0, 7
    FOR I = 1 TO 15: LOCATE I + 5, 10: PRINT SPACE$(60); : NEXT I
    LOCATE 7, 12: PRINT "The following shortcut keys can be used:"
    LOCATE 9, 22: PRINT "<Home> <Ctrl+Home> = Jump to the beginning"
    LOCATE 10, 24: PRINT "<End> <Ctrl+End> = Jump to the end"
    LOCATE 11, 37: PRINT "<"; CHR$(24); "> = Scroll up"
    LOCATE 12, 21: PRINT "<Enter> <Space> <"; CHR$(25); "> = Scroll down"
    LOCATE 13, 28: PRINT "<Tab> <PgDn> = Next page"
    LOCATE 14, 34: PRINT "<PgUp> = Previous page"
    LOCATE 15, 25: PRINT "<Ctrl+Left> <"; CHR$(27); "> = Scroll to the left"
    LOCATE 16, 24: PRINT "<Ctrl+Right> <"; CHR$(26); "> = Scroll to the right"
    LOCATE 17, 33: PRINT "<+> <-> = Change Tab size"
    LOCATE 19, 14: PRINT "<Esc> = <Alt+X> = <Alt+F4> = Exit program"
    WHILE INKEY$ = "": WEND
    CreateWindow
    UpdateStatus
END SUB

FUNCTION kCtrlEnd
    R = kEnd
    X& = 0
    kCtrlEnd = 1
END FUNCTION

FUNCTION kCtrlHome
    X& = 0
    Y& = 0
    P& = 1
    kCtrlHome = 1
END FUNCTION

FUNCTION kDown

    SAVE& = P&
    IF Y& + 2 < LINES& THEN
        Y& = Y& + 1
        DIM FP AS STRING * 4
        GET #2, (Y& - 1) * 4 + 1, FP
        P& = CVL(FP)
    END IF
    IF SAVE& <> P& THEN kDown = 1
END FUNCTION

FUNCTION kEnd

    SAVE& = P&
    IF LINES& <= PAGE THEN
        P& = 1
    ELSE
        DIM FP AS STRING * 4
        GET #2, (LINES& - PAGE) * 4 + 1, FP
        P& = CVL(FP)
    END IF
    IF SAVE& <> P& THEN kEnd = 1
    Y& = LINES& - PAGE
END FUNCTION

FUNCTION kHome
    P& = 1
    Y& = 0
    kHome = 1
END FUNCTION

FUNCTION kPgDn
    DIM FP AS STRING * 4
    SAVE& = P&
    IF Y& + PAGE + 1 < LINES& THEN
        Y& = Y& + PAGE
        GET #2, (Y& - 1) * 4 + 1, FP
        P& = CVL(FP)
    END IF
    IF SAVE& <> P& THEN kPgDn = 1
END FUNCTION

FUNCTION kPgUp
   
    SAVE& = P&
    IF Y& > PAGE THEN
        Y& = Y& - PAGE
        DIM FP AS STRING * 4
        GET #2, (Y& - 1) * 4 + 1, FP
        P& = CVL(FP)
    ELSE
        P& = 1
        Y& = 0
    END IF
    IF SAVE& <> P& THEN kPgUp = 1
END FUNCTION

FUNCTION kUp

    SAVE& = P&
    IF Y& < 2 THEN
        P& = 1
        Y& = 0
    ELSE
        Y& = Y& - 1
        DIM FP AS STRING * 4
        GET #2, (Y& - 1) * 4 + 1, FP
        P& = CVL(FP)
    END IF
    IF SAVE& <> P& THEN kUp = 1
END FUNCTION

SUB UpdateScreen

    PP& = P&  ' PP is going to be our file pointer within this sub
              ' so we can leave P unchanged

    XX# = 1   ' XX and YY are needed as we fill up the screen
    YY# = 1   ' with data to tell us where we are in the file

    screenX = 1  ' Actual screen coordinates where the next
    screenY = 2  ' character will be printed

    SKIP = 0  ' TAB characters turn into a series of imaginary spaces
              ' So, we have to suspend reading from the file while we
              ' process these spaces.
              ' When SKIP = 0 then we read from the file.
              ' When SKIP > 0 then we are just getting spaces.

    PREV = 0  ' holds the previous new line character
              ' We need to keep track of this so we can treat the
              ' 10-13 sequence as one pair instead of two line breaks


    ' P& file pointer is now pointing to the first data character
    ' in the upper left-hand corner.

    DO
        IF SKIP > 0 THEN
            SKIP = SKIP - 1
            A = 32
        ELSE
            GET #1, PP&, C
            PP& = PP& + 1
            A = ASC(C)
            IF PP& > FS# THEN A = 13
        END IF

        IF A = 10 OR A = 13 THEN   ' PROCESSING NEW LINE CHARACTER
            IF PREV = 0 THEN
                BR = 1      ' If the previous byte was plain data,
                            ' then we will do a line break now.
                PREV = A
            ELSE
                IF PREV = A THEN
                    BR = 1  ' If the previous byte was the same line break
                            ' character as this one, then we're probably
                            ' reading a linux-type text file, so we treat
                            ' this new line character as a new line break.
                ELSE
                    BR = 0  ' otherwise if the previous byte was 10 and now
                            ' we're getting a 13 or vice versa, then we treat
                            ' them as one pair, so we don't break line again.
                END IF
                PREV = 0
            END IF

            ' Do line break
            IF BR = 1 THEN
                LOCATE screenY, screenX
                PRINT SPACE$(80 - screenX);
                screenX = 1
                screenY = screenY + 1
                IF screenY > PAGE + 1 THEN EXIT DO
                YY# = YY# + 1
                XX# = 1
            END IF
        ELSE
            PREV = 0   ' The byte we are about to process
                       ' is not a new-line character:

            IF A = 9 THEN
                SKIP = TABS
                A = 32
            END IF

            IF XX# > X& AND screenX < 80 THEN
                DEF SEG = &HB800
                POKE (screenY - 1) * 160 + (screenX - 1) * 2, A
                screenX = screenX + 1
            END IF
            
            IF XX# < X& + 81 THEN
                XX# = XX# + 1
            END IF
        END IF

    LOOP

END SUB

SUB UpdateScrollbar

    COLOR 0, 7
    LOCATE 2, 80: PRINT CHR$(24);
    FOR I = 0 TO 21
        LOCATE I + 3, 80
        IF FIX(Y& / LINES& * 21) = I THEN PRINT "ð";  ELSE PRINT CHR$(178);
    NEXT I
    LOCATE 24, 80: PRINT CHR$(25);
    COLOR 7, 0
END SUB

SUB UpdateStatus

    COLOR 0, 7

    ' Print X and Y offsets
    O$ = STR$(Y& + 1) + ":" + LTRIM$(STR$(X& + 1))
    LOCATE 25, 3: PRINT O$ + SPACE$(10);

    ' Print lines
    LOCATE 25, 31: PRINT "Lines:"; LINES&;


    ' Print TAB size
    LOCATE 25, 50: PRINT "TAB="; LTRIM$(STR$(TABS + 1)); " ";


    ' Print Date & Time
    LOCATE 25, 58
    M = VAL(MID$(DATE$, 1, 2))
    D = VAL(MID$(DATE$, 4, 2))
    Y$ = MID$(DATE$, 7, 4)
    M$ = MID$("JanFebMarAprMayJunJulAugSepOctNovDec", (M - 1) * 3 + 1, 3)
    H = VAL(MID$(TIME$, 1, 2))
    IF H > 12 THEN H = H - 12: Z$ = "pm" ELSE Z$ = "am"
    IF H = 0 THEN H = 12
    PRINT CHR$(179); " "; M$; D; Y$; " "; STR$(H); MID$(TIME$, 3, 3); Z$;

    COLOR 7, 0

END SUB