[Back to TEXTFILE SWAG index] [Back to Main SWAG index] [Original]

    { Ok, this viewer will smooth scroll through a text file.  There is no
        filesize limit, but it can only handle up to 147456(!) lines of text.
        Oh yeah, you'd best have a disk cache loaded or else it won't be
        smooth at all (because it reads every line from disk as it goes).
        It also displays a progress bar so that you know how far into the
        file you are. All code 100% original by Jon Merkel.  Use it in any
        way you want.                                                           }

    {$G+,I-,R-,S-,M 4096,65536,655360}
    const
        DownKey = $50;                          { Scan code for the down arrow  }
        UpKey   = $48;                          { Scan code for the up arrow    }
        EscKey  = $1;                           { Scan code for the escape key  }
        done: boolean = false;
    type
        list = array [0..16382] of longint;     { array of file positions       }
    var
        linelist: array [0..8] of ^list;        { holds up to 147456 lines      }
        f: text;
        pos, count, maximum, line, oldline: longint;
        j, k, velocity: integer;
        segment: word;
        s: string[80];
        buffer: array [0..24*160-1] of byte;
        DisplayString, Attribs: array [0..15] of byte;

    procedure InitList;                         { Allocate file position lists  }
    var
        j: word;
        fseg: word;
    begin
        j := 0;
        while (MaxAvail > 65535) and (j<9) do begin
            getmem(linelist[j], 65535);
            inc(j);
        end;
        maximum := longint(j)*16384;
        writeln('Memory for ', maximum, ' lines');
    end;

    function TextPos(var f: text): longint; assembler;      { Get file position }
    asm
        mov ax,4201h; les di,[f]; mov bx,es:[di]; xor cx,cx; xor dx,dx;
        int 21h; sub ax,es:[di+10]; add ax,word ptr es:[di+8]; adc dx,0;
    end;

    procedure TextSeek(var f: text; fpos: longint); assembler;  { Set file pos  }
    asm
        mov ax,4200h; les di,[f]; mov bx,es:[di]; mov cx,word [fpos+2];
        mov dx,word [fpos]; int 21h; xor ax,ax; mov es:[di+8],ax;
        mov es:[di+10],ax;
    end;

    procedure display(segment: word; s: string);    { Write string at segment   }
    var
        o, j: word;
    begin
        o := 0;
        for j := 1 to length(s) do begin
            mem[segment:o] := ord(s[j]); inc(o,2); end;
        while o < 160 do begin
            mem[segment:o] := 32; inc(o,2); end;
    end;

    procedure movw(var source,dest; num: word); assembler;  { move() but words  }
    asm
        push ds; les di,[dest]; lds si,[source];
        mov cx,[num]; rep movsw; pop ds
    end;

    procedure ModFont; assembler;
    asm
        mov dx,03C4h; mov ax,0402h; out dx,ax; mov ax,0704h; out dx,ax
        mov dl,0CEh; mov ax,0204h; out dx,ax; mov ax,0005h; out dx,ax
        inc ax; out dx,ax
    end;
    procedure SetFont; assembler;
    asm
        mov dx,03C4h; mov ax,0302h; out dx,ax; mov ax,0304h; out dx,ax
        mov dl,0CEh; mov ax,0004h; out dx,ax; mov ax,1005h; out dx,ax
        mov ax,0E06h; out dx,ax
    end;

    procedure ShowPercent;
    var
        j, k: integer;
        whole, remainder: word;
        s: string[7];
        mask: byte;
    begin
        inc(pos,12); inc(count,12);
        fillchar(DisplayString, 16, ' ');
        fillchar(attribs, 16, $4F);
        whole := (pos*128 div count) shr 3;
        remainder := (pos*128 div count) and 7;
        fillchar(DisplayString, whole, #219);
        str(pos*100 div count, s);
        dec(pos,12); dec(count,12);
        s := s+'%';
        k := 7 - length(s) shr 1;
        for j := 1 to length(s) do begin
            DisplayString[k+j] := ord(s[j]);
            if k+j < whole then
                attribs[k+j] := $F4;
        end;
        if remainder <> 0 then begin
            ModFont;
            move(mem[$A000:DisplayString[whole] shl 5], mem[$A000:864], 16);
            mask := not ($FF shr remainder);
            for j := 0 to 15 do
                mem[$A000:864+j] := mem[$A000:864+j] xor mask;
            SetFont;
            DisplayString[whole] := 27;
        end;
        for j := 0 to 15 do begin
            mem[$B800:j*2+260] := DisplayString[j];
            mem[$B800:j*2+261] := attribs[j];
        end;
    end;

    (**********************  M A I N  P R O G R A M  ***************************)

    begin
        s := paramstr(1);
        for j := 1 to length(s) do s[j] := upcase(s[j]);
        assign(f, s);
        writeln;
        reset(f);
        if (paramstr(1)='') or (ioresult <> 0) then begin
            writeln('Specify VALID filename on command line');
            halt;
        end;
        count := 0;
        InitList;
        write('Now loading.');
        while not eof(f) and (count<maximum) do begin
            linelist[count shr 14]^[count and 16383] := TextPos(f);
            inc(count);
            if count and 1023=0 then write('.');
            readln(f);
        end;
        close(f);
        writeln;
        writeln(count, ' lines read');
        writeln;
        write('Press a key to continue...');
        asm mov ah,0; int 16h; end;

        asm mov ax,3; int 10h; end;                     { set 80x25 text mode   }
        asm mov dx,03DAh; in al,dx; mov dl,0C0h;
            mov al,30h; out dx,al; mov al,36; out dx,al; end;
        asm mov dx,03D4h; mov ax,7018h; out dx,ax;
            mov ax,1F07h; out dx,ax; mov ax,0F09h;
            out dx,ax; mov ax,0A00Dh; out dx,ax; end;
        asm in al,21h; or al,2; out 21h,al; end;        { disable the keyboard  }
        asm mov ax,0100h; mov cx,2000h; int 10h; end;   { hide the cursor       }
        display($B80A, '   Filename :                          Progress :');
        for j := 0 to 79 do
            mem[$B800:j*2] := 196;
        for j := 1 to length(s) do begin
            mem[$B80A:j*2+26] := ord(s[j]);
            mem[$B80A:j*2+27] := 11;
        end;

        pos := 0; velocity := 0; oldline := 0;
        count := (count-23)*16; if count<0 then count:=0;
        reset(f);
        for j := 0 to 23 do if not eof(f) then begin
            readln(f, s);
            display($B814+j*10, s);
        end;
        movw(mem[$B814:0], buffer, 24*80);

        repeat
            line := pos shr 4;
            while port[$3DA] and 8<>0 do;
            while port[$3DA] and 8=0 do;
            portw[$3D4] := (pos and 15) shl 8 + 8;

            j := line-oldline;
            if j>0 then begin                                   { Go forwards   }
                k := 24-j;
                movw(buffer[j*160], mem[$B814:0], k*80);
                segment := $B814 + k*10;
                for oldline := oldline+1 to line do begin
                    readln(f, s);
                    display(segment, s);
                    inc(segment, 10);
                end;
                movw(mem[$B814:0], buffer, 24*80);
            end
            else if j<0 then begin                              { Go backwards  }
                TextSeek(f, linelist[line shr 14]^[line and 16383]);
                segment := $B814;
                for oldline := oldline-1 downto line do begin
                    readln(f,s);
                    display(segment, s);
                    inc(segment, 10);
                end;
                movw(buffer, mem[$B814:-j*160], (24+j)*80);
                TextSeek(f, linelist[(line+24) shr 14]^[(line+24) and 16383]);
                movw(mem[$B814:0], buffer, 24*80);
            end;
            ShowPercent;

            case port[$60] of
                DownKey : if velocity < 350 then inc(velocity,2);
                UpKey   : if velocity > -350 then dec(velocity,2);
                EscKey  : done := true;
            end;
            inc(pos, velocity);
            if pos<0 then begin
                pos := 0; velocity := 0; end
            else if pos>count then begin
                pos := count; velocity := 0; end;
            if velocity > 0 then
                dec(velocity)
            else if velocity < 0 then
                inc(velocity);

        until done;

        asm in al,21h; and al,253; out 21h,al; end;         { enable keyboard   }
        asm mov ax,3; int 10h; end;                         { reset text mode   }
    end.

[Back to TEXTFILE SWAG index] [Back to Main SWAG index] [Original]