[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]